home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / src / tclMac.c < prev    next >
Text File  |  1993-11-21  |  66KB  |  2,905 lines
  1.  
  2. /*
  3. ** This source code was written by Tim Endres
  4. ** Email: time@ice.com.
  5. ** USMail: 8840 Main Street, Whitmore Lake, MI  48189
  6. **
  7. */
  8.  
  9. #pragma segment TCL
  10.  
  11. #include <resources.h>
  12. #include <memory.h>
  13. #include <files.h>
  14. #include <GestaltEqu.h>
  15. #include <string.h>
  16. #include <packages.h>
  17. #include <folders.h>
  18. #include <aliases.h>
  19. #include <ToolUtils.h>
  20. #include <errors.h>
  21. #include <stdarg.h>
  22. #include <Folders.h>
  23. #include <Sound.h>
  24. #include <Traps.h>
  25.  
  26. #include "tcl.h"
  27. #include "tclMac.h"
  28. #include "XTCL.h"
  29. #include "stat.h"
  30.  
  31. #include "version.h"
  32.  
  33. char    *tcl_check_path_termination( char *path );
  34.  
  35. /*
  36. ** NOTE - _tclmac_user_interrupt_
  37. ** The following tclMac variable is used to allow the
  38. ** application to interrupt the tcl evaluation process.
  39. ** If this variable is set to 1, by any function, then
  40. ** the next invocation of command parsing within Tcl_Eval()
  41. ** will cause the interpretation to halt and the message
  42. ** "*** user interrupt ***" to be added to the result.
  43. */
  44. int _tclmac_user_interrupt_ = 0;
  45.  
  46. /*
  47. ** NOTE - _tclmac_apprenum_
  48. ** The following tclMac variable is set by the call to
  49. ** Tcl_InitMacintoshOnce(). It is used to determine the
  50. ** path to the application, as well as its name to set
  51. ** the corresponding environment variables. It is also
  52. ** used by the Mac_EvalResource() command to locate
  53. ** resources in the application resource fork.
  54. **
  55. ** Further use of this variable is deprecated!
  56. */
  57. static short    _tclmac_apprenum_ = -1;
  58.  
  59.  
  60. int
  61. TclMac_IsAliasFile(clientData, interp, argc, argv)
  62.     ClientData    clientData;
  63.     Tcl_Interp    *interp;
  64.     int            argc;
  65.     char        **argv;
  66.     {
  67.     int                aliases_available = 0, myerr;
  68.     long            gestaltLong;
  69.     char            pascal_name[256],
  70.                     *ptr;
  71.     CInfoPBRec        cpb;
  72.     struct stat        statbuf;
  73. #pragma unused (clientData)
  74.  
  75.     if (argc != 2)
  76.         {
  77.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  78.             " filename\"", (char *) NULL);
  79.         return TCL_ERROR;
  80.         }
  81.  
  82.     if (GestaltAvailable())
  83.         {        
  84.         myerr = Gestalt(gestaltAliasMgrAttr, &gestaltLong);
  85.         if (myerr == noErr)
  86.             if ((gestaltLong & (1 << gestaltAliasMgrPresent)) != 0)
  87.                 aliases_available = 1;
  88.         }
  89.  
  90.     if ( ! aliases_available )
  91.         {
  92.         Tcl_AppendResult(interp, "0", NULL);
  93.         return TCL_OK;
  94.         }
  95.         
  96.     if ( stat( argv[1], &statbuf ) != 0)
  97.         {
  98.         Tcl_AppendResult(interp, "could not locate file \"", argv[1], "\" ", NULL);
  99.         return TCL_ERROR;
  100.         }
  101.     
  102.     if ( S_ISDIR(statbuf.st_mode) )
  103.         {
  104.         pascal_name[0] = '\0';
  105.         
  106.         cpb.hFileInfo.ioDirID = statbuf.st_ino;
  107.         cpb.hFileInfo.ioFDirIndex = -1;
  108.         }
  109.     else
  110.         {
  111.         ptr = strrchr(argv[1], ':');
  112.         if (ptr != NULL)
  113.             strcpy(pascal_name, ptr);
  114.         else
  115.             strcpy(pascal_name, argv[1]);
  116.         c2pstr(pascal_name);
  117.         
  118.         cpb.hFileInfo.ioDirID = statbuf.st_parid;
  119.         cpb.hFileInfo.ioFDirIndex = 0;
  120.         }
  121.     
  122.     cpb.hFileInfo.ioCompletion = 0;
  123.     cpb.hFileInfo.ioNamePtr = (unsigned char *)pascal_name;
  124.     cpb.hFileInfo.ioVRefNum = statbuf.st_dev;
  125.     myerr = PBGetCatInfo( &cpb, (Boolean)0 );
  126.     if (myerr != noErr)
  127.         {
  128.         Tcl_AppendResult(interp, "error getting file info for \"",
  129.                             argv[1], "\" ", Tcl_MacGetError(interp, myerr), NULL);
  130.         return TCL_ERROR;
  131.         }
  132.     else
  133.         {
  134.         if ( (cpb.hFileInfo.ioFlFndrInfo.fdFlags & 0x00008000) != 0 )
  135.             Tcl_SetResult(interp, "1", TCL_STATIC);
  136.         else
  137.             Tcl_SetResult(interp, "0", TCL_STATIC);
  138.         return TCL_OK;
  139.         }
  140.     }
  141.  
  142. int
  143. TclMac_ResolveAlias(clientData, interp, argc, argv)
  144.     ClientData    clientData;
  145.     Tcl_Interp    *interp;
  146.     int            argc;
  147.     char        **argv;
  148.     {
  149.     FSSpec            fspec;
  150.     Boolean            wasAliased, isFolder;
  151.     int                aliases_available = 0, myerr;
  152.     long            gestaltLong;
  153.     char            pascal_name[256],
  154.                     *ptr, savech;
  155.     struct stat        statbuf;
  156. #pragma unused (clientData)
  157.  
  158.     if (argc != 2)
  159.         {
  160.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  161.             " filename\"", (char *) NULL);
  162.         return TCL_ERROR;
  163.         }
  164.  
  165.     if (GestaltAvailable())
  166.         {        
  167.         myerr = Gestalt(gestaltAliasMgrAttr, &gestaltLong);
  168.         if (myerr == noErr)
  169.             if ((gestaltLong & (1 << gestaltAliasMgrPresent)) != 0)
  170.                 aliases_available = 1;
  171.         }
  172.  
  173.     if ( ! aliases_available )
  174.         {
  175.         Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
  176.         return TCL_OK;
  177.         }
  178.         
  179.     if ( stat( argv[1], &statbuf ) != 0)
  180.         {
  181.         Tcl_AppendResult(interp, "could not locate file \"", argv[1], "\" ", NULL);
  182.         return TCL_ERROR;
  183.         }
  184.     
  185.     ptr = strrchr(argv[1], ':');
  186.     if (ptr != NULL)
  187.         strcpy(pascal_name, ptr);
  188.     else
  189.         strcpy(pascal_name, argv[1]);
  190.     c2pstr(pascal_name);
  191.     
  192.     BlockMove(pascal_name, fspec.name, pascal_name[0]+1);
  193.     fspec.parID = statbuf.st_parid;
  194.     fspec.vRefNum = statbuf.st_dev;
  195.     myerr = ResolveAliasFile(&fspec, (Boolean)1, &isFolder, &wasAliased);
  196.     if (myerr != noErr)
  197.         {
  198.         Tcl_AppendResult(interp, "error resolving file \"", argv[1], "\" ",
  199.                             Tcl_MacGetError(interp, myerr),
  200.                             (char *) NULL);
  201.         return TCL_ERROR;
  202.         }
  203.     else if (wasAliased)
  204.         {
  205.         p2cstr(fspec.name);
  206.         Tcl_ResetResult(interp);
  207.         if (ptr != NULL)
  208.             {
  209.             savech = *(ptr+1);
  210.             *(ptr+1) = '\0';
  211.             Tcl_AppendResult(interp, argv[1], NULL);
  212.             *(ptr+1) = savech;
  213.             }
  214.         Tcl_AppendResult(interp, fspec.name, NULL);
  215.         return TCL_OK;
  216.         }
  217.     else
  218.         {
  219.         Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
  220.         return TCL_OK;
  221.         }
  222.     }
  223.  
  224. #ifdef UNDONE
  225.  
  226. /* Feel free! You must be careful on the second filename. See Copy. */
  227.  
  228. int
  229. TclMac_CreateAlias(clientData, interp, argc, argv)
  230.     ClientData    clientData;
  231.     Tcl_Interp    *interp;
  232.     int            argc;
  233.     char        **argv;
  234.     {
  235.     int                aliases_available = 0, myerr;
  236.     long            gestaltLong;
  237.     char            pascal_name[256],
  238.                     *ptr;
  239.     AliasHandle        alias;
  240.     CInfoPBRec        cpb;
  241.     struct stat        statbuf;
  242. #pragma unused (clientData)
  243.  
  244.     if (argc != 3)
  245.         {
  246.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  247.             " filename aliasfilename\"", (char *) NULL);
  248.         return TCL_ERROR;
  249.         }
  250.  
  251.     if (GestaltAvailable())
  252.         {        
  253.         myerr = Gestalt(gestaltAliasMgrAttr, &gestaltLong);
  254.         if (myerr == noErr)
  255.             if ((gestaltLong & (1 << gestaltAliasMgrPresent)) != 0)
  256.                 aliases_available = 1;
  257.         }
  258.  
  259.     if ( ! aliases_available )
  260.         {
  261.         Tcl_AppendResult(interp, "could not create alias - ",
  262.                             "aliases not supported on this Macintosh", NULL);
  263.         return TCL_ERROR;
  264.         }
  265.         
  266.     if ( stat( argv[1], &statbuf ) != 0)
  267.         {
  268.         Tcl_AppendResult(interp, "could not locate file \"", argv[1], "\" ", NULL);
  269.         return TCL_ERROR;
  270.         }
  271.     
  272.     if ( S_ISDIR(statbuf.st_mode) )
  273.         {
  274.         pascal_name[0] = '\0';
  275.         
  276.         cpb.hFileInfo.ioDirID = statbuf.st_ino;
  277.         cpb.hFileInfo.ioFDirIndex = -1;
  278.         }
  279.     else
  280.         {
  281.         ptr = strrchr(argv[1], ':');
  282.         if (ptr != NULL)
  283.             strcpy(pascal_name, ptr);
  284.         else
  285.             strcpy(pascal_name, argv[1]);
  286.         c2pstr(pascal_name);
  287.         
  288.         cpb.hFileInfo.ioDirID = statbuf.st_parid;
  289.         cpb.hFileInfo.ioFDirIndex = 0;
  290.         }
  291.     
  292.     cpb.hFileInfo.ioCompletion = 0;
  293.     cpb.hFileInfo.ioNamePtr = (unsigned char *)pascal_name;
  294.     cpb.hFileInfo.ioVRefNum = statbuf.st_dev;
  295.     myerr = PBGetCatInfo( &cpb, (Boolean)0 );
  296.     if (myerr != noErr)
  297.         {
  298.         Tcl_AppendResult(interp, "error getting file info for \"",
  299.                             argv[1], "\" ", Tcl_MacGetError(interp, myerr), NULL);
  300.         return TCL_ERROR;
  301.         }
  302.  
  303.     BlockMove(pascal_name, fspec.name, pascal_name[0]+1);
  304.     fspec.parID = statbuf.st_parid;
  305.     fspec.vRefNum = statbuf.st_dev;
  306.     myerr = NewAlias( (FSSpec *)0, &fspec, &alias );
  307.     if (myerr != noErr)
  308.         {
  309.         Tcl_AppendResult(interp, "error creating alias record for \"",
  310.                             argv[1], "\" ", Tcl_MacGetError(interp, myerr), NULL);
  311.         return TCL_ERROR;
  312.         }
  313.     
  314.     /* UNDONE */
  315.     }
  316.  
  317. #endif
  318.  
  319.  
  320. int
  321. TclMac_GetFileInfo(clientData, interp, argc, argv)
  322.     ClientData    clientData;
  323.     Tcl_Interp    *interp;
  324.     int            argc;
  325.     char        **argv;
  326.     {
  327.     int            myerr;
  328.     char        buffer1[128];
  329.     char        pascal_name[256], *ptr;
  330.     CInfoPBRec    cpb;
  331.     DateTimeRec    cdate, mdate;
  332.     struct stat    statbuf;
  333.     
  334. #pragma unused (clientData, argc)
  335.  
  336.     if ( argc != 2)
  337.         {
  338.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  339.                             argv[0], " filename\"", NULL);
  340.         return TCL_ERROR;
  341.         }
  342.     
  343.     if ( stat( argv[1], &statbuf ) != 0)
  344.         {
  345.         Tcl_AppendResult(interp, "could not locate file \"", argv[1], "\" ", NULL);
  346.         return TCL_ERROR;
  347.         }
  348.     
  349.     if ( S_ISDIR(statbuf.st_mode) )
  350.         {
  351.         pascal_name[0] = '\0';
  352.         
  353.         cpb.hFileInfo.ioDirID = statbuf.st_ino;
  354.         cpb.hFileInfo.ioFDirIndex = -1;
  355.         }
  356.     else
  357.         {
  358.         ptr = strrchr(argv[1], ':');
  359.         if (ptr != NULL)
  360.             strcpy(pascal_name, ptr);
  361.         else
  362.             strcpy(pascal_name, argv[1]);
  363.         c2pstr(pascal_name);
  364.         
  365.         cpb.hFileInfo.ioDirID = statbuf.st_parid;
  366.         cpb.hFileInfo.ioFDirIndex = 0;
  367.         }
  368.     
  369.     cpb.hFileInfo.ioCompletion = 0;
  370.     cpb.hFileInfo.ioNamePtr = (unsigned char *)pascal_name;
  371.     cpb.hFileInfo.ioVRefNum = statbuf.st_dev;
  372.     myerr = PBGetCatInfo( &cpb, (Boolean)0 );
  373.     
  374.     if (myerr != noErr)
  375.         {
  376.         Tcl_AppendResult(interp, "error getting file info for \"", argv[1], "\" ",
  377.                             Tcl_MacGetError(interp, myerr), NULL);
  378.         return TCL_ERROR;
  379.         }
  380.     else {
  381.         Secs2Date(cpb.hFileInfo.ioFlCrDat, &cdate);
  382.         Secs2Date(cpb.hFileInfo.ioFlMdDat, &mdate);
  383.  
  384.         sprintf(buffer1, "%4.4s", &cpb.hFileInfo.ioFlFndrInfo.fdCreator);
  385.         Tcl_AppendElement(interp, buffer1);
  386.         
  387.         sprintf(buffer1, "%4.4s", &cpb.hFileInfo.ioFlFndrInfo.fdType);
  388.         Tcl_AppendElement(interp, buffer1);
  389.         
  390.         sprintf(buffer1, "%c%c%c%c%c%c%c",
  391.                     ( ((cpb.hFileInfo.ioFlFndrInfo.fdFlags&fHasBundle)!=0)    ? 'B' : 'b' ),
  392.                     ( ((cpb.hFileInfo.ioFlFndrInfo.fdFlags&fOnDesk)!=0)        ? 'D' : 'd' ),
  393.                     ( ((cpb.hFileInfo.ioFlFndrInfo.fdFlags&0x0100)!=0)        ? 'I' : 'i' ),
  394.                     ( ((cpb.hFileInfo.ioFlFndrInfo.fdFlags&0x8000)!=0)        ? 'L' : 'l' ),
  395.                     ( ((cpb.hFileInfo.ioFlFndrInfo.fdFlags&0x0080)!=0)        ? 'M' : 'm' ),
  396.                     ( ((cpb.hFileInfo.ioFlFndrInfo.fdFlags&0x1000)!=0)        ? 'S' : 's' ),
  397.                     ( ((cpb.hFileInfo.ioFlFndrInfo.fdFlags&fInvisible)!=0)    ? 'V' : 'v' )
  398.                     );
  399.         Tcl_AppendElement(interp, buffer1);
  400.  
  401.         sprintf(buffer1, "%02d/%02d/%02d %02d:%02d:%02d",
  402.                     cdate.month, cdate.day, cdate.year%100, cdate.hour, cdate.minute, cdate.second
  403.                     );
  404.         Tcl_AppendElement(interp, buffer1);
  405.         
  406.         sprintf(buffer1, "%02d/%02d/%02d %02d:%02d:%02d",
  407.                     mdate.month, mdate.day, mdate.year%100, mdate.hour, mdate.minute, mdate.second
  408.                     );
  409.         Tcl_AppendElement(interp, buffer1);
  410.         
  411.         sprintf(buffer1, "%d %d",
  412.                     cpb.hFileInfo.ioFlFndrInfo.fdLocation.h,
  413.                     cpb.hFileInfo.ioFlFndrInfo.fdLocation.v
  414.                     );
  415.         Tcl_AppendElement(interp, buffer1);
  416.         
  417.         if ( S_ISDIR(statbuf.st_mode) )
  418.             {
  419.             sprintf(buffer1, "%ld", cpb.dirInfo.ioDrDirID);
  420.             Tcl_AppendElement(interp, buffer1);
  421.  
  422.             sprintf(buffer1, "%ld", cpb.dirInfo.ioDrNmFls);
  423.             Tcl_AppendElement(interp, buffer1);
  424.             }
  425.         else
  426.             {
  427.             sprintf(buffer1, "%ld", cpb.hFileInfo.ioFlLgLen);
  428.             Tcl_AppendElement(interp, buffer1);
  429.             
  430.             sprintf(buffer1, "%ld", cpb.hFileInfo.ioFlRLgLen);
  431.             Tcl_AppendElement(interp, buffer1);
  432.             }
  433.         
  434.         sprintf(buffer1, "%ld", cpb.hFileInfo.ioFlParID);
  435.         Tcl_AppendElement(interp, buffer1);
  436.         
  437.         return TCL_OK;
  438.         }
  439.     }
  440.  
  441. TclMac_ParseDateString( date, dtstring )
  442.     DateTimeRec        *date;
  443.     char            *dtstring;
  444.     {
  445.     int            result = 1,
  446.                 date_args,
  447.                 time_args,
  448.                 yr, mo, dy,
  449.                 hr, mn, sc;
  450.     long        seconds;
  451.     char        *ptr,
  452.                 datestr[128],
  453.                 timestr[128],
  454.                 ampmstr[64];
  455.  
  456.     date_args = sscanf(dtstring, "%s %s %s", &datestr, ×tr, &mstr);
  457.     if (date_args)
  458.         {
  459.         if ( sscanf(datestr, "%d/%d/%d", &mo, &dy, &yr) == 3 )
  460.             {
  461.             date->year = yr;
  462.             date->month = mo;
  463.             date->day = dy;
  464.             if (date_args > 1)
  465.                 {
  466.                 time_args = sscanf(timestr, "%d:%d:%d", &hr, &mn, &sc);
  467.                 if (time_args == 2 || time_args < 3)
  468.                     {
  469.                     date->hour = hr;
  470.                     date->minute = mn;
  471.                     if (time_args > 2)
  472.                         date->second = sc;
  473.  
  474.                     if (date_args > 2)
  475.                         {
  476.                         if (strcmp(ampmstr, "PM") == 0)
  477.                             {
  478.                             if (date->hour < 12)
  479.                                 date->hour += 12;
  480.                             }
  481.                         else if (strcmp(ampmstr, "AM") == 0)
  482.                             {
  483.                             if (date->hour == 12)
  484.                                 date->hour = 0;
  485.                             }
  486.                         else
  487.                             result = 0;
  488.                         }
  489.                     }
  490.                 else
  491.                     result = 0;
  492.                 }
  493.             }
  494.         else
  495.             result = 0;
  496.         }
  497.     else
  498.         result = 0;
  499.     
  500.     return result;
  501.     }
  502.  
  503. int
  504. TclMac_SetFileInfo(clientData, interp, argc, argv)
  505.     ClientData    clientData;
  506.     Tcl_Interp    *interp;
  507.     int            argc;
  508.     char        **argv;
  509.     {
  510.     char    *ptr;
  511.     int        i, j, date_args;
  512.     Str255    pascal_name;
  513.     char    datestr[128], timestr[128], ampmstr[64];
  514.     HParamBlockRec    pb;
  515.     struct stat        statbuf;
  516.     DateTimeRec        date;
  517.     unsigned long    seconds;
  518.     int                yr, mo, dy, hr, mn, sc;
  519. #pragma unused (clientData)
  520.  
  521.     if ( argc < 3 )
  522.         {
  523.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  524.                             argv[0], " filename settings...\"", NULL);
  525.         return TCL_ERROR;
  526.         }
  527.     
  528.     if ( stat( argv[1], &statbuf ) != 0)
  529.         {
  530.         Tcl_AppendResult(interp, "could not locate file \"", argv[1], "\" ", NULL);
  531.         return TCL_ERROR;
  532.         }
  533.     
  534.     ptr = strrchr(argv[1], ':');
  535.     if (ptr != NULL)
  536.         strcpy(pascal_name, ptr);
  537.     else
  538.         strcpy(pascal_name, argv[1]);
  539.     c2pstr(pascal_name);
  540.     
  541.     pb.fileParam.ioCompletion = 0;
  542.     pb.fileParam.ioNamePtr = (unsigned char *)pascal_name;
  543.     pb.fileParam.ioDirID = statbuf.st_parid;
  544.     pb.fileParam.ioVRefNum = statbuf.st_dev;
  545.     pb.fileParam.ioFDirIndex = 0;
  546.     pb.fileParam.ioFVersNum = 0;
  547.     PBHGetFInfo(&pb, FALSE);
  548.     if (pb.fileParam.ioResult != noErr)
  549.         {
  550.         Tcl_AppendResult(interp, "error getting file info for \"", argv[1], "\" ",
  551.                             Tcl_MacGetError(interp, pb.fileParam.ioResult),
  552.                             (char *) NULL);
  553.         return TCL_ERROR;
  554.         }
  555.     else
  556.         {
  557.         for (i = 2 ; i < argc ; i += 2)
  558.             {
  559.             if (argv[i][0] == '-')
  560.                 {
  561.                 switch (argv[i][1])
  562.                     {
  563.                     case 'a':    /* attributes (lowercase = 0, uppercase = 1) [*] */
  564.                         ptr = argv[i+1];
  565.                         for (ptr = argv[i+1] ; *ptr ; ptr++)
  566.                             {
  567.                             switch (*ptr)
  568.                                 {
  569.                                 case 'L': case 'l':    /* Locked / Not */
  570.                                     if (*ptr == 'L')
  571.                                         pb.fileParam.ioFlFndrInfo.fdFlags |= 0x8000;
  572.                                     else
  573.                                         pb.fileParam.ioFlFndrInfo.fdFlags &= ~0x8000;
  574.                                     break;
  575.                                 case 'V': case 'v':    /* Invisible / Visible */
  576.                                     if (*ptr == 'V')
  577.                                         pb.fileParam.ioFlFndrInfo.fdFlags |= fInvisible;
  578.                                     else
  579.                                         pb.fileParam.ioFlFndrInfo.fdFlags &= ~fInvisible;
  580.                                     break;
  581.                                 case 'B': case 'b':    /* Bundled / Not */
  582.                                     if (*ptr == 'B')
  583.                                         pb.fileParam.ioFlFndrInfo.fdFlags |= fHasBundle;
  584.                                     else
  585.                                         pb.fileParam.ioFlFndrInfo.fdFlags &= ~fHasBundle;
  586.                                     break;
  587.                                 case 'S': case 's':    /* System / Not */
  588.                                     if (*ptr == 'S')
  589.                                         pb.fileParam.ioFlFndrInfo.fdFlags |= 0x1000;
  590.                                     else
  591.                                         pb.fileParam.ioFlFndrInfo.fdFlags &= ~0x1000;
  592.                                     break;
  593.                                 case 'I': case 'i':    /* Inited / Not */
  594.                                     if (*ptr == 'I')
  595.                                         pb.fileParam.ioFlFndrInfo.fdFlags |= 0x0100;
  596.                                     else
  597.                                         pb.fileParam.ioFlFndrInfo.fdFlags &= ~0x0100;
  598.                                     break;
  599.                                 case 'D': case 'd':    /* 0x0001 Desktop / Not */
  600.                                     if (*ptr == 'D')
  601.                                         pb.fileParam.ioFlFndrInfo.fdFlags |= fOnDesk;
  602.                                     else
  603.                                         pb.fileParam.ioFlFndrInfo.fdFlags &= ~fOnDesk;
  604.                                     break;
  605.                                 case 'M': case 'm':    /* Sharable / Not */
  606.                                     if (*ptr == 'M')
  607.                                         pb.fileParam.ioFlFndrInfo.fdFlags |= 0x0080;
  608.                                     else
  609.                                         pb.fileParam.ioFlFndrInfo.fdFlags &= ~0x0080;
  610.                                     break;
  611.                                 }
  612.                             }
  613.                         break;
  614.                         
  615.                     case 'c':    /* file creator */
  616.                         ptr = (char *) &pb.fileParam.ioFlFndrInfo.fdCreator;
  617.                         for (j = 0 ; argv[i+1][j] ; j++)
  618.                             *ptr++ = argv[i+1][j];
  619.                         for ( ; j < 4 ; j++)
  620.                             *ptr++ = ' ';
  621.                         break;
  622.                         
  623.                     case 'd':    /* creation date (mm/dd/yy [hh:mm[:ss] [AM | PM]]) [*] */
  624.                         if ( TclMac_ParseDateString( &date, argv[i+1] ) )
  625.                             {
  626.                             Date2Secs( &date, &seconds );
  627.                             pb.fileParam.ioFlCrDat = seconds;
  628.                             }
  629.                         else
  630.                             {
  631.                             Tcl_AppendResult(interp, "bad creation date syntax \"",
  632.                                                 argv[i+1], "\" ", NULL);
  633.                             return TCL_ERROR;
  634.                             }
  635.                         break;
  636.                     
  637.                     case 'm':    /* modification date (mm/dd/yy [hh:mm[:ss] [AM | PM]]) [*] */
  638.                         if ( TclMac_ParseDateString( &date, argv[i+1] ) )
  639.                             {
  640.                             Date2Secs( &date, &seconds );
  641.                             pb.fileParam.ioFlMdDat = seconds;
  642.                             }
  643.                         else
  644.                             {
  645.                             Tcl_AppendResult(interp, "bad modification date syntax \"",
  646.                                                 argv[i+1], "\" ", NULL);
  647.                             return TCL_ERROR;
  648.                             }
  649.                         break;
  650.                     
  651.                     case 't':    /* file type */
  652.                         ptr = (char *) &pb.fileParam.ioFlFndrInfo.fdType;
  653.                         for (j = 0 ; argv[i+1][j] ; j++)
  654.                             *ptr++ = argv[i+1][j];
  655.                         for ( ; j < 4 ; j++)
  656.                             *ptr++ = ' ';
  657.                         break;
  658.                     }
  659.                 }
  660.             else
  661.                 {
  662.                 Tcl_AppendResult(interp, "\"", argv[0], "\" invalid option ",
  663.                                         argv[1], (char *) NULL);
  664.                 return TCL_ERROR;
  665.                 }
  666.             }
  667.         
  668.         PBHSetFInfo(&pb, FALSE);
  669.         if (pb.fileParam.ioResult != noErr)
  670.             {
  671.             Tcl_AppendResult(interp, "error setting file info for \"", argv[1], "\" ",
  672.                                 Tcl_MacGetError(interp, pb.fileParam.ioResult),
  673.                                 (char *) NULL);
  674.             return TCL_ERROR;
  675.             }
  676.         }
  677.     
  678.     return TCL_OK;
  679.     }
  680.  
  681. int
  682. TclMac_CD(clientData, interp, argc, argv)
  683.     ClientData    clientData;
  684.     Tcl_Interp    *interp;
  685.     int            argc;
  686.     char        **argv;
  687.     {
  688.     int            myerr;
  689.     WDPBRec        wpb;
  690.     struct stat    statbuf;
  691. #pragma unused (clientData)
  692.  
  693.     if (argc != 2)
  694.         {
  695.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  696.             " dirName\"", (char *) NULL);
  697.         return TCL_ERROR;
  698.         }
  699.  
  700.     if ( stat( argv[1], &statbuf ) != 0)
  701.         {
  702.         Tcl_AppendResult(interp, "could not locate file \"", argv[1],
  703.                             "\" ", Tcl_PosixError(interp), NULL);
  704.         return TCL_ERROR;
  705.         }
  706.     
  707.     if ( ! S_ISDIR(statbuf.st_mode) )
  708.         {
  709.         Tcl_AppendResult(interp, "\"", argv[1], "\" not a directory", (char *) NULL);
  710.         return TCL_ERROR;
  711.         }
  712.  
  713.     myerr = TclMac_CWDChgDir( statbuf.st_dev, statbuf.st_ino );
  714.     if (myerr != noErr)
  715.         {
  716.         Tcl_AppendResult(interp, "error setting current directory \"",
  717.                             argv[1], "\" ", Tcl_MacGetError(interp, myerr),
  718.                             (char *) NULL);
  719.         return TCL_ERROR;
  720.         }
  721.     
  722.     return TCL_OK;
  723.     }
  724.  
  725. int
  726. TclMac_PWD(clientData, interp, argc, argv)
  727.     ClientData    clientData;
  728.     Tcl_Interp    *interp;
  729.     int            argc;
  730.     char        **argv;
  731.     {
  732.     int        length;
  733.     char    path[2048];
  734. #pragma unused (clientData, argc, argv)
  735.  
  736.     if ( argc != 1 )
  737.         {
  738.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  739.                             argv[0], "\"", NULL);
  740.         return TCL_ERROR;
  741.         }
  742.     
  743.     TclMac_CWDPathName(path);
  744.     
  745.     Tcl_SetResult(interp, path, TCL_VOLATILE);
  746.  
  747.     return TCL_OK;
  748.     }
  749.  
  750. int
  751. TclMac_MkDir(clientData, interp, argc, argv)
  752.     ClientData  clientData;
  753.     Tcl_Interp *interp;
  754.     int         argc;
  755.     char      **argv;
  756.     {
  757.     int            idx, dirArgc, result;
  758.     short        vRefNum;
  759.     long        dirID;
  760.     char        **dirArgv, *dirName, *scanPtr, *ptr, pascal_name[256], savech;
  761.     HParamBlockRec    pb;
  762.     struct stat        statbuf;
  763.     Tcl_DString        tildeBuf;
  764.  
  765. #pragma unused (clientData)
  766.  
  767.     if ( argc != 2)
  768.         if ( argc != 3 || strcmp(argv [1], "-path") )
  769.             {
  770.             Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
  771.                               " ?-path? dirlist", (char *) NULL);
  772.             return TCL_ERROR;
  773.             }
  774.  
  775.     if ( Tcl_SplitList(interp, argv[argc - 1], &dirArgc, &dirArgv) != TCL_OK )
  776.         return TCL_ERROR;
  777.  
  778.     Tcl_DStringInit (&tildeBuf);
  779.  
  780.     /*
  781.     ** Make all the directories, optionally making directories along the path.
  782.     */
  783.  
  784.     for ( idx = 0 ; idx < dirArgc ; idx++ )
  785.         {
  786.         dirName = Tcl_TildeSubst(interp, dirArgv[idx], &tildeBuf);
  787.         if (dirName == NULL)
  788.             {
  789.             Tcl_DStringFree (&tildeBuf);
  790.             ckfree ((char *) dirArgv);
  791.             return TCL_ERROR;
  792.             }
  793.  
  794.         dirID = TclMac_CWDDirID();
  795.         vRefNum = TclMac_CWDVRefNum();
  796.         scanPtr = dirName;
  797.  
  798.         if (*dirName != ':')
  799.             {
  800.             ptr = strchr(dirName, ':');
  801.             if (ptr != NULL)
  802.                 {
  803.                 savech = *(ptr+1);
  804.                 *(ptr+1) = '\0';
  805.                 if ( stat( dirName, &statbuf ) == 0 )
  806.                     {
  807.                     scanPtr = ptr;
  808.                     dirID = statbuf.st_ino;
  809.                     vRefNum = statbuf.st_dev;
  810.                     }
  811.                 else
  812.                     {
  813.                     Tcl_AppendResult (interp, "error locating volume \"", dirName, 
  814.                                       "\" ", (char *) NULL);
  815.                     *(ptr+1) = savech;
  816.                     return TCL_ERROR;
  817.                     }
  818.                 
  819.                 *(ptr+1) = savech;
  820.                 }
  821.             }
  822.         
  823.         /*
  824.         ** Make leading directories, if requested.
  825.         */
  826.         result = 0;  /* Start out ok, for dirs that are skipped */
  827.         for ( ; *scanPtr != '\0' ; )
  828.             {
  829.             if (*scanPtr == ':')
  830.                 ++scanPtr;
  831.             
  832.             ptr = strchr(scanPtr, ':');
  833.             if ( ptr == NULL )
  834.                 {
  835.                 ptr = scanPtr + strlen(scanPtr);
  836.                 }
  837.             
  838.             savech = *ptr;
  839.             *ptr = '\0';
  840.             if ( stat(dirName, &statbuf) < 0 )
  841.                 {
  842.                 if ( argc == 3 || savech == '\0')
  843.                     {
  844.                     strcpy(pascal_name, scanPtr);
  845.                     c2pstr(pascal_name);
  846.                     
  847.                     pb.fileParam.ioCompletion = 0;
  848.                     pb.fileParam.ioNamePtr = (unsigned char *)pascal_name;
  849.                     pb.fileParam.ioVRefNum = vRefNum;
  850.                     pb.fileParam.ioDirID = dirID;
  851.                     
  852.                     result = PBDirCreate( (HParmBlkPtr)&pb, FALSE );
  853.                     p2cstr(pascal_name);
  854.                     
  855.                     if (result != noErr)
  856.                         {
  857.                         Tcl_AppendResult(interp, "error creating directory \"",
  858.                                             pascal_name, "\" ",
  859.                                             Tcl_MacGetError(interp, result),
  860.                                             (char *) NULL);
  861.                         return TCL_ERROR;
  862.                         }
  863.                     else
  864.                         {
  865.                         if (stat(dirName, &statbuf) < 0)
  866.                             {
  867.                             Tcl_AppendResult(interp, "error locating directory \"",
  868.                                                 dirName, "\" ", (char *) NULL);
  869.                             return TCL_ERROR;
  870.                             }
  871.                         }
  872.                     }
  873.                 }
  874.             else
  875.                 {
  876.                 Tcl_AppendResult(interp, "error path \"", dirName, 
  877.                                   "\" does not exist ", (char *) NULL);
  878.                 return TCL_ERROR;
  879.                 }
  880.  
  881.             dirID = statbuf.st_ino;
  882.             vRefNum = statbuf.st_dev;
  883.  
  884.             *ptr = savech;
  885.             scanPtr = ptr;
  886.             }
  887.         
  888.         Tcl_DStringFree (&tildeBuf);
  889.         }
  890.  
  891.     ckfree( (char *) dirArgv );
  892.     return TCL_OK;
  893.     }
  894.  
  895. int
  896. TclMac_RmDir(clientData, interp, argc, argv)
  897.     ClientData  clientData;
  898.     Tcl_Interp *interp;
  899.     int         argc;
  900.     char      **argv;
  901.     {
  902.     int                idx, dirArgc, result;
  903.     char            **dirArgv, *dirName;
  904.     HParamBlockRec    pb;
  905.     struct stat        statbuf;
  906.     Tcl_DString        tildeBuf;
  907.  
  908. #pragma unused (clientData)
  909.  
  910.     if ( argc != 2)
  911.         if ( argc != 3 || strcmp(argv [1], "-nocomplain") )
  912.             {
  913.             Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
  914.                               " ?-nocomplain? dirlist", (char *) NULL);
  915.             return TCL_ERROR;
  916.             }
  917.  
  918.     if ( Tcl_SplitList(interp, argv[argc - 1], &dirArgc, &dirArgv) != TCL_OK )
  919.         return TCL_ERROR;
  920.  
  921.     Tcl_DStringInit (&tildeBuf);
  922.  
  923.     for ( idx = 0 ; idx < dirArgc ; idx++ )
  924.         {
  925.         dirName = Tcl_TildeSubst(interp, dirArgv[idx], &tildeBuf);
  926.         if (dirName == NULL)
  927.             {
  928.             if (argc != 3)
  929.                 {
  930.                 Tcl_AppendResult(interp, "could not substitute for directory \"",
  931.                                     dirArgv[idx], "\" ", (char *) NULL);
  932.                 Tcl_DStringFree (&tildeBuf);
  933.                 return TCL_ERROR;
  934.                 }
  935.             
  936.             continue;
  937.             }
  938.  
  939.         if ( stat( dirName, &statbuf ) < 0 )
  940.             {
  941.             if (argc != 3)
  942.                 {
  943.                 Tcl_AppendResult(interp, "error locating directory \"", dirArgv[idx], "\" ",
  944.                                     (char *) NULL);
  945.                 Tcl_DStringFree (&tildeBuf);
  946.                 return TCL_ERROR;
  947.                 }
  948.  
  949.             continue;
  950.             }
  951.         else if ( ! S_ISDIR(statbuf.st_mode) )
  952.             {
  953.             if (argc != 3)
  954.                 {
  955.                 Tcl_AppendResult(interp, "error \"", dirArgv[idx], "\" not a directory ",
  956.                                     (char *) NULL);
  957.                 Tcl_DStringFree (&tildeBuf);
  958.                 return TCL_ERROR;
  959.                 }
  960.  
  961.             continue;
  962.             }
  963.         
  964.         pb.fileParam.ioCompletion = 0;
  965.         pb.fileParam.ioNamePtr = NULL;
  966.         pb.fileParam.ioVRefNum = statbuf.st_dev;
  967.         pb.fileParam.ioDirID = statbuf.st_ino;
  968.         
  969.         result = PBHDelete( (HParmBlkPtr)&pb, FALSE );
  970.  
  971.         if ( result != noErr && argc != 3 )
  972.             {
  973.             Tcl_AppendResult(interp, "error deleting \"", dirArgv[idx], "\" ",
  974.                                 Tcl_MacGetError(interp, result), (char *) NULL);
  975.             Tcl_DStringFree (&tildeBuf);
  976.             return TCL_ERROR;
  977.             }
  978.             
  979.         Tcl_DStringFree (&tildeBuf);
  980.         }
  981.  
  982.     ckfree ((char *) dirArgv);
  983.     return TCL_OK;
  984.     }
  985.  
  986.  
  987. int
  988. TclMac_Echo(clientData, interp, argc, argv)
  989.     ClientData    clientData;
  990.     Tcl_Interp    *interp;
  991.     int            argc;
  992.     char        **argv;
  993.     {
  994.     int        i;
  995.     TCLPFI    print_proc;
  996.     
  997. #    pragma unused (interp, clientData)
  998.  
  999.     print_proc = Tcl_GetPrintProcedure();
  1000.     
  1001.     for (i = 1 ; i < argc ; ++i )
  1002.         {
  1003.         if (print_proc != NULL)
  1004.             (*print_proc) (argv[i]);
  1005.         else
  1006.             fputs(argv[i], stdout);
  1007.  
  1008.         if ( i < (argc - 1) )
  1009.             if (print_proc != NULL)
  1010.                 (*print_proc) (" ");
  1011.             else
  1012.                 fputs(" ", stdout);
  1013.         }
  1014.  
  1015.     if (print_proc != NULL)
  1016.         (* print_proc)(SHELL_LINE_SEPER_STR);
  1017.     else
  1018.         fputs(SHELL_LINE_SEPER_STR, stdout);
  1019.  
  1020.     return TCL_OK;
  1021.     }
  1022.  
  1023.  
  1024. /*
  1025. ** Expand arguments. '*argc' has only the arguments in it, not the original
  1026. ** argc of the routine that called 'globArgs'. Likewise, 'argv' has been
  1027. ** incremented.
  1028. */
  1029. globArgs(Tcl_Interp *interp, int *argc, char ***argv)
  1030.     {
  1031.     int        res, len;
  1032.     char    *list;
  1033.  
  1034.     // Places the globbed args all into 'interp->result'.
  1035.     res = Tcl_GlobCmd(0L, interp, *argc + 1, *argv - 1);
  1036.     if (res != TCL_OK)
  1037.         {
  1038.         return FALSE;
  1039.         }
  1040.     
  1041.     len = strlen(interp->result);
  1042.     list = (char *)calloc(len + 1, 1);
  1043.     strcpy(list, interp->result);
  1044.     Tcl_ResetResult(interp);
  1045.  
  1046.     res = Tcl_SplitList(interp, list, argc, argv);
  1047.     if (res != TCL_OK)
  1048.         {
  1049.         return FALSE;
  1050.         }
  1051.     
  1052.     free(list);
  1053.  
  1054.     return TRUE;
  1055.     }
  1056.  
  1057. TclMac_LS(clientData, interp, argc, argv)
  1058.     ClientData     clientData;
  1059.     Tcl_Interp     *interp;
  1060.     int         argc;
  1061.     char         **argv;
  1062.     {
  1063.     int            line, i, j, k,
  1064.                 fFlag = FALSE,
  1065.                 lFlag = FALSE,
  1066.                 cFlag = FALSE,
  1067.                 hFlag = FALSE;
  1068.     int            lines, fieldLength, len = 0, maxLen = 0, perLine, result;
  1069.     char        theLine[512 + 2], *temp;
  1070.     char        c;
  1071.     char        **origArgv = argv;
  1072.     struct stat        statbuf;
  1073.     
  1074. #pragma unused (clientData)
  1075.     
  1076.     // CHECK_FOR_WINS;
  1077.     
  1078.     for (i = 1; i < argc; i++)
  1079.         {
  1080.         if (argv[i][0] != '-')
  1081.             break;
  1082.         
  1083.         for ( j = 1 ; argv[i][j] ; ++j )
  1084.             switch(argv[i][j])
  1085.                 {
  1086.                 case 'C':
  1087.                     cFlag = TRUE;
  1088.                     break;
  1089.                 case 'F':
  1090.                     fFlag = TRUE;
  1091.                     break;
  1092.                 case 'H':
  1093.                     hFlag = TRUE;
  1094.                     break;
  1095.                 case 'l':
  1096.                     lFlag = TRUE;
  1097.                     break;
  1098.                 default:
  1099.                     Tcl_AppendResult( interp, "error - unknown flag ",
  1100.                                         "usage: ls -CFHl ?files? ", TCL_STATIC );
  1101.                     return TCL_ERROR;
  1102.                 }
  1103.         }
  1104.  
  1105.     argv += i;
  1106.     argc -= i;
  1107.  
  1108.     // No file specifications.
  1109.     if (! argc)
  1110.         {
  1111.         argc = 1;
  1112.         argv = origArgv;
  1113.         strcpy(argv[0], "*");
  1114.         }
  1115.     
  1116.     if (! globArgs(interp, &argc, &argv))
  1117.         {
  1118.         Tcl_SetResult(interp, SHELL_LINE_SEPER_STR, TCL_STATIC);
  1119.         return TCL_OK;
  1120.         }
  1121.  
  1122.     if (lFlag)
  1123.         {
  1124.         if (hFlag)
  1125.             {
  1126.             sprintf(theLine, "T %7s %7s %8s %8s %4s %4s %s",
  1127.                         "Size/ID", "RSize/N", "ModTime", "ModDate",
  1128.                         "CRTR", "TYPE", "Name" );
  1129.             Tcl_AppendResult(interp, theLine, SHELL_LINE_SEPER_STR, NULL);
  1130.             Tcl_AppendResult(interp,
  1131.                 "-------------------------------------------------------------",
  1132.                 SHELL_LINE_SEPER_STR, NULL);
  1133.             }
  1134.         
  1135.         for (i = 0; i < argc; i++)
  1136.             {
  1137.             char    time[16];
  1138.             char    date[16];
  1139.             int        result;
  1140.  
  1141.             result = stat( argv[i], &statbuf );
  1142.             if (result != 0)
  1143.                 {
  1144.                 Tcl_AppendResult(interp, " error could not get info for \"", argv[i],
  1145.                                     "\" ", Tcl_PosixError(interp), (char *) NULL);
  1146.                 return TCL_ERROR;
  1147.                 }
  1148.  
  1149.             IUTimeString( statbuf.st_atime, FALSE, (unsigned char *)time );
  1150.             IUDateString( statbuf.st_atime, shortDate, (unsigned char *)date );
  1151.             p2cstr(time);
  1152.             p2cstr(date);
  1153.             
  1154.             if (S_ISDIR(statbuf.st_mode))
  1155.                 {
  1156.                 // Directory
  1157.                 sprintf(theLine, "D %7d %7d %8s %8s %-4.4s %-4.4s %s",
  1158.                             statbuf.st_ino, statbuf.st_nlink, time, date,
  1159.                             &statbuf.fdCreator, &statbuf.fdType, argv[i] );
  1160.                 }
  1161.             else
  1162.                 {
  1163.                 // FILE
  1164.                 sprintf( theLine, "F %7d %7d %8s %8s %-4.4s %-4.4s %s",
  1165.                          statbuf.st_size, statbuf.st_rsize, time, date,
  1166.                          &statbuf.fdCreator, &statbuf.fdType, argv[i] );
  1167.                 }
  1168.             
  1169.             Tcl_AppendResult(interp, theLine, SHELL_LINE_SEPER_STR, NULL);
  1170.             }
  1171.         
  1172.         if (interp->result != NULL && *(interp->result) != '\0')
  1173.             {
  1174.             int        slen = strlen(interp->result);
  1175.             if (interp->result[slen - 1] == SHELL_LINE_SEPER_CHAR)
  1176.                 interp->result[slen - 1] = '\0';
  1177.             }
  1178.         }
  1179.     else
  1180.         {
  1181.         // Ordinary case.
  1182.         for (i = 0; i < argc; i++)
  1183.             {
  1184.             /* UNDONE - Alias resolution handling */
  1185.             len = strlen(argv[i]);
  1186.             if (len > maxLen) maxLen = len;
  1187.             }
  1188.         
  1189.         fieldLength = maxLen + 3;
  1190.         if (! cFlag)
  1191.             perLine = 1;
  1192.         else
  1193.             perLine = 80 / fieldLength;
  1194.         
  1195.         lines = ((argc - 1) / perLine) + 1;
  1196.         theLine[sizeof(theLine) - 2] = SHELL_LINE_SEPER_CHAR;
  1197.         theLine[sizeof(theLine) - 1] = 0;
  1198.         
  1199.         for ( line = 0 ; line < lines ; ++line )
  1200.             {
  1201.             memset(theLine, ' ', sizeof(theLine) - 2);
  1202.             for ( k = 0 ; k < perLine ; ++k )
  1203.                 {
  1204.                 int        num = line + k * lines;
  1205.                 
  1206.                 if (num >= argc) continue;
  1207.                 
  1208.                 temp = theLine + (k * fieldLength);
  1209.                 memset(temp, ' ', fieldLength);
  1210.                 len = strlen(argv[num]);
  1211.                 strncpy(temp, argv[num], len);
  1212.                 if (fFlag)
  1213.                     {
  1214.                     result = stat( argv[num], &statbuf );
  1215.                     if (result != 0)
  1216.                         {
  1217.                         Tcl_AppendResult(interp, " error could not get info for \"", argv[num],
  1218.                                             "\" ", Tcl_PosixError(interp), (char *) NULL);
  1219.                         return TCL_ERROR;
  1220.                         }
  1221.                     
  1222.                     if (S_ISDIR(statbuf.st_mode))
  1223.                         {
  1224.                         if (temp[len-1] != ':')
  1225.                             c = ':';
  1226.                         }
  1227.                     else if ( statbuf.fdType == (long)'APPL')
  1228.                         {
  1229.                         c = '•';
  1230.                         }
  1231.                     else c = ' ';
  1232.                     
  1233.                     temp[len] = c;
  1234.                     }
  1235.                 }
  1236.             
  1237.             if (line == (lines - 1))
  1238.                 {
  1239.                 theLine[fieldLength * perLine] = 0;
  1240.                 }
  1241.             
  1242.             theLine[80] = SHELL_LINE_SEPER_CHAR;
  1243.             theLine[81] = 0;
  1244.             Tcl_AppendResult(interp, theLine, NULL);
  1245.             }
  1246.         }
  1247.     
  1248.     ckfree((char *) argv);
  1249.     
  1250.     return TCL_OK;
  1251.     }
  1252.  
  1253. int
  1254. TclMac_CTime(clientData, interp, argc, argv)
  1255.     ClientData    clientData;
  1256.     Tcl_Interp    *interp;
  1257.     int            argc;
  1258.     char        **argv;
  1259.     {
  1260.     char    *ptr;
  1261.     unsigned long seconds;
  1262. #pragma unused (clientData)
  1263.  
  1264.     if (argc != 2) {
  1265.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1266.             " time\"", (char *) NULL);
  1267.         return TCL_ERROR;
  1268.         }
  1269.     else
  1270.         {
  1271.         seconds = atol(argv[1]);
  1272.         ptr = ctime(&seconds);
  1273.         ptr[strlen(ptr)-1] = '\0';    /* Drop \n */
  1274.         Tcl_SetResult(interp, ptr, TCL_VOLATILE);
  1275.         return TCL_OK;
  1276.         }
  1277.     }
  1278.  
  1279. int
  1280. TclMac_DateTime(clientData, interp, argc, argv)
  1281.     ClientData    clientData;
  1282.     Tcl_Interp    *interp;
  1283.     int            argc;
  1284.     char        **argv;
  1285.     {
  1286.     char            datestr[64], timestr[64];
  1287.     unsigned long    now;
  1288. #pragma unused (clientData)
  1289.  
  1290.     if (argc < 2 || argc > 3)
  1291.         {
  1292.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1293.             " time ?format?\" where format is \"long, short, or abbrev\"", (char *) NULL);
  1294.         return TCL_ERROR;
  1295.         }
  1296.     else
  1297.         {
  1298.         if (sscanf(argv[1], "%lu", &now) != 1)
  1299.             {
  1300.             Tcl_AppendResult(interp, "invalid time \"", argv[1], "\"", (char *) NULL);
  1301.             return TCL_ERROR;
  1302.             }
  1303.         else
  1304.             {
  1305.             IUDateString(now, ( argc == 2 ? shortDate :
  1306.                                 ( argv[2][0] == 's' ? shortDate :
  1307.                                     (argv[2][0] == 'l' ? longDate : abbrevDate) ) ),
  1308.                                 (unsigned char *)datestr);
  1309.             IUTimeString(now, TRUE, (unsigned char *)timestr);
  1310.             p2cstr(datestr);
  1311.             p2cstr(timestr);
  1312.             Tcl_AppendElement(interp, datestr);
  1313.             Tcl_AppendElement(interp, timestr);
  1314.             return TCL_OK;
  1315.             }
  1316.         }
  1317.     }
  1318.  
  1319. int
  1320. TclMac_Ticks(clientData, interp, argc, argv)
  1321.     ClientData    clientData;
  1322.     Tcl_Interp    *interp;
  1323.     int            argc;
  1324.     char        **argv;
  1325.     {
  1326.     char    tickstr[64];
  1327. #pragma unused (clientData, argv)
  1328.  
  1329.     if (argc != 1)
  1330.         {
  1331.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], "\"", (char *) NULL);
  1332.         return TCL_ERROR;
  1333.         }
  1334.     else
  1335.         {
  1336.         sprintf(tickstr, "%lu", TickCount());
  1337.         Tcl_SetResult(interp, tickstr, TCL_VOLATILE);
  1338.         return TCL_OK;
  1339.         }
  1340.     }
  1341.  
  1342. int
  1343. TclMac_CvtTime(clientData, interp, argc, argv)
  1344.     ClientData    clientData;
  1345.     Tcl_Interp    *interp;
  1346.     int            argc;
  1347.     char        **argv;
  1348.     {
  1349.     unsigned long now, myseconds;
  1350.     char    nowstr[64];
  1351. #pragma unused (clientData, argv)
  1352.  
  1353.     if ( argc != 3 ||
  1354.          ( strcmp("-mtu", argv[1]) && strcmp("-utm", argv[1])) )
  1355.         {
  1356.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1357.                             "\" [-mtu|-utm] seconds", (char *) NULL);
  1358.         return TCL_ERROR;
  1359.         }
  1360.     else
  1361.         {
  1362.         if ( sscanf(argv[2], "%ld", &myseconds) != 1 )
  1363.             {
  1364.             Tcl_AppendResult(interp, "invalid seconds parameter \"", argv[2],
  1365.                                 "\"", (char *) NULL);
  1366.             return TCL_ERROR;
  1367.             }
  1368.         
  1369.         if ( strcmp(argv[1], "-mtu") == 0 )
  1370.             {
  1371.             myseconds -= TIMEDIFF;
  1372.             }
  1373.         else if ( strcmp(argv[1], "-utm") == 0 )
  1374.             {
  1375.             myseconds += TIMEDIFF;
  1376.             }
  1377.             
  1378.         sprintf( nowstr, "%lu", myseconds );
  1379.         Tcl_SetResult(interp, nowstr, TCL_VOLATILE);
  1380.         
  1381.         return TCL_OK;
  1382.         }
  1383.     }
  1384.  
  1385. int
  1386. TclMac_Now(clientData, interp, argc, argv)
  1387.     ClientData    clientData;
  1388.     Tcl_Interp    *interp;
  1389.     int            argc;
  1390.     char        **argv;
  1391.     {
  1392.     unsigned long now;
  1393.     char    nowstr[64];
  1394. #pragma unused (clientData, argv)
  1395.  
  1396.     if ( ! ( argc == 1 || (argc == 2 && strcmp(argv[1], "-unix")) ) )
  1397.         {
  1398.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1399.                             "\" ?-unix?", (char *) NULL);
  1400.         return TCL_ERROR;
  1401.         }
  1402.     else
  1403.         {
  1404.         GetDateTime(&now);
  1405.         sprintf( nowstr, "%lu", (argc == 1 ? now : (now - TIMEDIFF)) );
  1406.         Tcl_SetResult(interp, nowstr, TCL_VOLATILE);
  1407.         return TCL_OK;
  1408.         }
  1409.     }
  1410.  
  1411. int
  1412. TclMac_RM(clientData, interp, argc, argv)
  1413.     ClientData    clientData;
  1414.     Tcl_Interp    *interp;
  1415.     int            argc;
  1416.     char        **argv;
  1417.     {
  1418.     int                myerr;
  1419.     short            vrefnum;
  1420.     long            dirid;
  1421.     char            *ptr1;
  1422.     Str32            pascal_name;
  1423.     int                idx, myArgc, result;
  1424.     int                nocomplain = 0;
  1425.     char            **myArgv, *fileName;
  1426.     HParamBlockRec    pb;
  1427.     struct stat        statbuf;
  1428.     Tcl_DString        tildeBuf;
  1429.  
  1430. #pragma unused (clientData)
  1431.  
  1432.     if ( argc != 2)
  1433.         if ( argc != 3 || ( strcmp(argv [1], "-f")
  1434.                             && strcmp(argv [1], "-nocomplain") ) )
  1435.             {
  1436.             Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
  1437.                               " ?-nocomplain? filelist", (char *) NULL);
  1438.             return TCL_ERROR;
  1439.             }
  1440.  
  1441.     if (argc == 3)
  1442.         nocomplain = 1;
  1443.         
  1444.     if ( Tcl_SplitList(interp, argv[argc - 1], &myArgc, &myArgv) != TCL_OK )
  1445.         return TCL_ERROR;
  1446.  
  1447.     Tcl_DStringInit (&tildeBuf);
  1448.  
  1449.     for ( idx = 0 ; idx < myArgc ; idx++ )
  1450.         {
  1451.         fileName = Tcl_TildeSubst(interp, myArgv[idx], &tildeBuf);
  1452.         if (fileName == NULL)
  1453.             {
  1454.             if (!nocomplain)
  1455.                 {
  1456.                 Tcl_AppendResult(interp, "could not substitute for directory \"",
  1457.                                     myArgv[idx], "\" ", (char *) NULL);
  1458.                 Tcl_DStringFree (&tildeBuf);
  1459.                 return TCL_ERROR;
  1460.                 }
  1461.             continue;
  1462.             }
  1463.  
  1464.         if ( stat( fileName, &statbuf ) != 0 )
  1465.             {
  1466.             if (!nocomplain)
  1467.                 {
  1468.                 Tcl_AppendResult(interp, "could not locate file \"", fileName,
  1469.                                     "\" ", Tcl_PosixError(interp), (char *) NULL);
  1470.                 return TCL_ERROR;
  1471.                 }
  1472.             continue;
  1473.             }
  1474.         
  1475.         dirid = statbuf.st_parid;
  1476.         vrefnum = statbuf.st_dev;
  1477.         ptr1 = strrchr(fileName, ':');
  1478.         
  1479.         if (ptr1 == NULL)
  1480.             ptr1 = fileName;
  1481.         else
  1482.             ++ptr1;
  1483.         
  1484.         strncpy( (char *)pascal_name, ptr1, sizeof(pascal_name)-1 );
  1485.         pascal_name[sizeof(pascal_name)-1] = '\0';
  1486.         c2pstr((char *)pascal_name);
  1487.         
  1488.         pb.fileParam.ioCompletion = 0;
  1489.         pb.fileParam.ioNamePtr = pascal_name;
  1490.         pb.fileParam.ioVRefNum = vrefnum;
  1491.         pb.fileParam.ioDirID = dirid;
  1492.         myerr = PBHDelete(&pb, FALSE);
  1493.         if (myerr != noErr && !nocomplain)
  1494.             {
  1495.             Tcl_AppendResult(interp, "\"", argv[0], "\" ", "error deleting \"",
  1496.                             argv[1], "\" ", Tcl_MacGetError(interp, myerr), (char *) NULL);
  1497.             return TCL_ERROR;
  1498.             }
  1499.         }
  1500.     
  1501.     return TCL_OK;
  1502.     }
  1503.  
  1504. int
  1505. TclMac_MoveFile(clientData, interp, argc, argv)
  1506.     ClientData    clientData;
  1507.     Tcl_Interp    *interp;
  1508.     int            argc;
  1509.     char        **argv;
  1510.     {
  1511.     int            myerr,
  1512.                 force = 0;
  1513.     short        from_vrefnum,
  1514.                 to_vrefnum;
  1515.     long        from_dirid,
  1516.                 to_dirid;
  1517.     char        *ptr1, *ptr2,
  1518.                 *oldname, *newname,
  1519.                 savech;
  1520.     char        pascal_name[64],
  1521.                 from_name[64],
  1522.                 to_name[64];
  1523.                 
  1524.     HParamBlockRec    pb;
  1525.     CMovePBRec        mpb;
  1526.     struct stat        statbuf;
  1527.     
  1528. #pragma unused (clientData)
  1529.  
  1530.     if (argc < 3 || argc > 4)
  1531.         {
  1532.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1533.             " oldName newName ?force?\"", (char *) NULL);
  1534.         return TCL_ERROR;
  1535.         }
  1536.  
  1537.     if (argc == 4)
  1538.         {
  1539.         if (strcmp(argv[3], "force"))
  1540.             {
  1541.             Tcl_AppendResult(interp, "wrong parameter \"", argv[3], "\" : should be \"", argv[0],
  1542.                 " oldName newName ?force?\"", (char *) NULL);
  1543.             return TCL_ERROR;
  1544.             }
  1545.         
  1546.         force = 1;
  1547.         }
  1548.  
  1549.     oldname = argv[1];
  1550.     newname = argv[2];
  1551.  
  1552.     if ( stat( oldname, &statbuf ) != 0)
  1553.         {
  1554.         Tcl_AppendResult(interp, "could not locate file \"", oldname, "\" ", NULL);
  1555.         return TCL_ERROR;
  1556.         }
  1557.     
  1558.     from_dirid = statbuf.st_parid;
  1559.     from_vrefnum = statbuf.st_dev;
  1560.  
  1561.     ptr1 = strrchr(oldname, ':');
  1562.     ptr2 = strrchr(newname, ':');
  1563.     
  1564.     if (ptr1 != NULL)
  1565.         strcpy(from_name, ptr1 + 1);
  1566.     else
  1567.         strcpy(from_name, oldname);
  1568.         
  1569.     if (ptr2 != NULL)
  1570.         {
  1571.         savech = *(ptr2+1);
  1572.         *(ptr2+1) = '\0';
  1573.         tcl_path_to_dir(newname, &to_vrefnum, &to_dirid);
  1574.         *(ptr2+1) = savech;
  1575.         
  1576.         strcpy(to_name, ptr2 + 1);
  1577.         }
  1578.     else
  1579.         {
  1580.         strcpy(to_name, newname);
  1581.         to_dirid = TclMac_CWDDirID();
  1582.         to_vrefnum = TclMac_CWDVRefNum();
  1583.         }
  1584.     
  1585.     if ( from_vrefnum != to_vrefnum )
  1586.         {
  1587.         if (TclMac_CopyFile(clientData, interp, argc, argv) == TCL_ERROR)
  1588.             return TCL_ERROR;
  1589.         else
  1590.             return TclMac_RM(clientData, interp, --argc, argv);
  1591.         }
  1592.     
  1593.     if ( from_dirid != to_dirid )
  1594.         {
  1595.         strcpy(pascal_name, from_name);
  1596.         c2pstr(pascal_name);
  1597.         
  1598. retry_move:
  1599.         mpb.ioCompletion = 0;
  1600.         mpb.ioNamePtr = (unsigned char *)pascal_name;
  1601.         mpb.ioVRefNum = from_vrefnum;
  1602.         mpb.ioNewName = "\p";
  1603.         mpb.ioNewDirID = to_dirid;
  1604.         mpb.ioDirID = from_dirid;
  1605.         myerr = PBCatMove(&mpb, FALSE);
  1606.         if (myerr != noErr)
  1607.             {
  1608.             if (force && myerr == dupFNErr)
  1609.                 {
  1610.                 pb.fileParam.ioCompletion = 0;
  1611.                 pb.fileParam.ioNamePtr = (unsigned char *)pascal_name;
  1612.                 pb.fileParam.ioVRefNum = from_vrefnum;
  1613.                 pb.fileParam.ioFVersNum = 0;
  1614.                 pb.fileParam.ioDirID = to_dirid;
  1615.                 myerr = PBHDelete(&pb, FALSE);
  1616.                 if (myerr == noErr)
  1617.                     goto retry_move;
  1618.                 }
  1619.             
  1620.             Tcl_AppendResult(interp, "\"", argv[0], "\" error moving file ",
  1621.                                 Tcl_MacGetError(interp, myerr), (char *) NULL);
  1622.             return TCL_ERROR;
  1623.             }
  1624.         }
  1625.     
  1626.     if (strcmp(from_name, to_name) != 0)
  1627.         {
  1628.         c2pstr(from_name);
  1629.         c2pstr(to_name);
  1630.  
  1631. retry_rename:
  1632.         pb.ioParam.ioCompletion = 0;
  1633.         pb.ioParam.ioNamePtr = (unsigned char *)from_name;
  1634.         pb.ioParam.ioVRefNum = from_vrefnum;
  1635.         pb.ioParam.ioMisc = to_name;
  1636.         pb.ioParam.ioVersNum = 0;
  1637.         pb.fileParam.ioDirID = to_dirid;
  1638.         myerr = PBHRename(&pb, FALSE);
  1639.         if (myerr != noErr)
  1640.             {
  1641.             if (force && myerr == dupFNErr)
  1642.                 {
  1643.                 pb.fileParam.ioCompletion = 0;
  1644.                 pb.fileParam.ioNamePtr = (unsigned char *)to_name;
  1645.                 pb.fileParam.ioVRefNum = from_vrefnum;
  1646.                 pb.fileParam.ioFVersNum = 0;
  1647.                 pb.fileParam.ioDirID = to_dirid;
  1648.                 myerr = PBHDelete(&pb, FALSE);
  1649.                 if (myerr == noErr)
  1650.                     goto retry_rename;
  1651.                 }
  1652.  
  1653.             Tcl_AppendResult(interp, "\"", argv[0], "\" error renaming file ",
  1654.                                 Tcl_MacGetError(interp, myerr), (char *) NULL);
  1655.             return TCL_ERROR;
  1656.             }
  1657.         }
  1658.         
  1659.     return TCL_OK;
  1660.     }
  1661.  
  1662. int
  1663. TclMac_CopyFile(clientData, interp, argc, argv)
  1664.     ClientData    clientData;
  1665.     Tcl_Interp    *interp;
  1666.     int            argc;
  1667.     char        **argv;
  1668.     {
  1669.     int            myerr, eoferr, need_move = 0, need_rename = 0, force = 0;
  1670.     short        from_vrefnum, to_vrefnum, inerr, outerr;
  1671.     long        from_dirid, to_dirid;
  1672.     char        *ptr1, *ptr2, savech, *oldname, *newname;
  1673.     char        from_name[64], to_name[64];
  1674.     struct stat statbuf;
  1675.     HParamBlockRec    inparm, outparm;
  1676. #pragma unused (clientData)
  1677.  
  1678.     if (argc < 3 || argc > 4) {
  1679.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1680.             " fromName toName ?force?\"", (char *) NULL);
  1681.         return TCL_ERROR;
  1682.         }
  1683.  
  1684.     if (argc == 4)
  1685.         {
  1686.         if (strcmp(argv[3], "force"))
  1687.             {
  1688.             Tcl_AppendResult(interp, "wrong parameter \"", argv[3], "\" : should be \"", argv[0],
  1689.                 " oldName newName ?force?\"", (char *) NULL);
  1690.             return TCL_ERROR;
  1691.             }
  1692.         
  1693.         force = 1;
  1694.         }
  1695.  
  1696.     oldname = argv[1];
  1697.     newname = argv[2];
  1698.  
  1699.     if ( stat( oldname, &statbuf ) != 0)
  1700.         {
  1701.         Tcl_AppendResult(interp, "could not locate file \"", oldname, "\" ", NULL);
  1702.         return TCL_ERROR;
  1703.         }
  1704.     
  1705.     from_dirid = statbuf.st_parid;
  1706.     from_vrefnum = statbuf.st_dev;
  1707.     
  1708.     ptr1 = strrchr(oldname, ':');
  1709.     ptr2 = strrchr(newname, ':');
  1710.     
  1711.     if (ptr1 != NULL)
  1712.         strcpy(from_name, ptr1 + 1);
  1713.     else
  1714.         strcpy(from_name, oldname);
  1715.         
  1716.     if (ptr2 != NULL)
  1717.         {
  1718.         savech = *(ptr2+1);
  1719.         *(ptr2+1) = '\0';
  1720.         tcl_path_to_dir(newname, &to_vrefnum, &to_dirid);
  1721.         *(ptr2+1) = savech;
  1722.         
  1723.         strcpy(to_name, ptr2 + 1);
  1724.         }
  1725.     else
  1726.         {
  1727.         strcpy(to_name, newname);
  1728.         to_dirid = TclMac_CWDDirID();
  1729.         to_vrefnum = TclMac_CWDVRefNum();
  1730.         }
  1731.     
  1732.     c2pstr(from_name);
  1733.     c2pstr(to_name);
  1734.  
  1735.     inparm.ioParam.ioCompletion = 0;
  1736.     inparm.ioParam.ioNamePtr = (unsigned char *)from_name;
  1737.     inparm.ioParam.ioVRefNum = from_vrefnum;
  1738.     inparm.ioParam.ioVersNum = 0;
  1739.     inparm.ioParam.ioPermssn = fsRdPerm;
  1740.     inparm.ioParam.ioMisc = NULL;
  1741.     inparm.fileParam.ioDirID = from_dirid;
  1742.     inerr = PBHOpen(&inparm, FALSE);
  1743.     if (inerr != noErr)
  1744.         {
  1745.         p2cstr(from_name);
  1746.         Tcl_AppendResult(interp, "error opening DATA fork \"", from_name, "\" ",
  1747.                             Tcl_MacGetError(interp, inerr), (char *) NULL);
  1748.         return TCL_ERROR;
  1749.         }
  1750.  
  1751.     outparm.ioParam.ioCompletion = 0;
  1752.     outparm.ioParam.ioNamePtr = (unsigned char *)to_name;
  1753.     outparm.ioParam.ioVRefNum = to_vrefnum;
  1754.     outparm.ioParam.ioVersNum = 0;
  1755.     outparm.ioParam.ioPermssn = fsWrPerm;
  1756.     outparm.ioParam.ioMisc = NULL;
  1757.     outparm.fileParam.ioDirID = to_dirid;
  1758.     outerr = PBHCreate(&outparm, false);
  1759.     if ( (outerr != noErr && outerr != dupFNErr) ||
  1760.          (outerr == dupFNErr && ! force) )
  1761.         {
  1762.         PBClose((ParmBlkPtr)&inparm, false);
  1763.         p2cstr(to_name);
  1764.         Tcl_AppendResult(interp, "error creating DATA fork \"", to_name, "\" ",
  1765.                             Tcl_MacGetError(interp, outerr), (char *) NULL);
  1766.         return TCL_ERROR;
  1767.         }
  1768.     
  1769.     outerr = PBHOpen(&outparm, false);
  1770.     if (outerr != noErr)
  1771.         {
  1772.         PBClose((ParmBlkPtr)&inparm, false);
  1773.         p2cstr(to_name);
  1774.         Tcl_AppendResult(interp, "error opening DATA fork \"", to_name, "\" ",
  1775.                             Tcl_MacGetError(interp, outerr), (char *) NULL);
  1776.         return TCL_ERROR;
  1777.         }
  1778.     
  1779.     myerr = TclMac_CopyFork(&inparm, &outparm);
  1780.  
  1781.     PBGetEOF((ParmBlkPtr)&inparm, FALSE);
  1782.     outparm.ioParam.ioMisc = inparm.ioParam.ioMisc;
  1783.     eoferr = PBSetEOF((ParmBlkPtr)&outparm, FALSE);
  1784.     
  1785.     PBClose((ParmBlkPtr)&inparm, FALSE);
  1786.     PBClose((ParmBlkPtr)&outparm, FALSE);
  1787.     
  1788.     FlushVol(NULL, to_vrefnum);
  1789.  
  1790.     if (myerr != noErr)
  1791.         {
  1792.         p2cstr(to_name);
  1793.         p2cstr(from_name);
  1794.         Tcl_AppendResult(interp, "error copying DATA fork \"",
  1795.                             from_name, "\" to \"", to_name, "\" ", (char *) NULL);
  1796.         return TCL_ERROR;
  1797.         }
  1798.     
  1799.     if (eoferr != noErr)
  1800.         {
  1801.         Tcl_AppendResult(interp, "error setting DATA fork EOF ",
  1802.                             Tcl_MacGetError(interp, myerr), (char *) NULL);
  1803.         return TCL_ERROR;
  1804.         }
  1805.  
  1806.     inparm.ioParam.ioCompletion = 0;
  1807.     inparm.ioParam.ioNamePtr = (unsigned char *)from_name;
  1808.     inparm.ioParam.ioVRefNum = from_vrefnum;
  1809.     inparm.ioParam.ioVersNum = 0;
  1810.     inparm.ioParam.ioPermssn = fsRdPerm;
  1811.     inparm.ioParam.ioMisc = NULL;
  1812.     inparm.fileParam.ioDirID = from_dirid;
  1813.     myerr = PBHOpenRF(&inparm, FALSE);
  1814.     if (myerr != noErr && myerr != eofErr && myerr != fnfErr)
  1815.         {
  1816.         p2cstr(from_name);
  1817.         Tcl_AppendResult(interp, "error opening RSRC fork \"", from_name, "\" ",
  1818.                             Tcl_MacGetError(interp, myerr), (char *) NULL);
  1819.         return TCL_ERROR;
  1820.         }
  1821.     else if (myerr == noErr)
  1822.         {
  1823.         outparm.ioParam.ioCompletion = 0;
  1824.         outparm.ioParam.ioNamePtr = (unsigned char *)to_name;
  1825.         outparm.ioParam.ioVRefNum = to_vrefnum;
  1826.         outparm.ioParam.ioVersNum = 0;
  1827.         outparm.ioParam.ioPermssn = fsWrPerm;
  1828.         outparm.ioParam.ioMisc = NULL;
  1829.         outparm.fileParam.ioDirID = to_dirid;
  1830.         myerr = PBHOpenRF(&outparm, false);
  1831.         if (myerr != noErr)
  1832.             {
  1833.             PBClose((ParmBlkPtr)&inparm, FALSE);
  1834.             p2cstr(to_name);
  1835.             Tcl_AppendResult(interp, "error opening RSRC fork \"", to_name, "\" ",
  1836.                                 Tcl_MacGetError(interp, myerr), (char *) NULL);
  1837.             return TCL_ERROR;
  1838.             }
  1839.         
  1840.         myerr = TclMac_CopyFork(&inparm, &outparm);
  1841.     
  1842.         PBGetEOF((ParmBlkPtr)&inparm, FALSE);
  1843.         outparm.ioParam.ioMisc = inparm.ioParam.ioMisc;
  1844.         eoferr = PBSetEOF((ParmBlkPtr)&outparm, FALSE);
  1845.         
  1846.         PBClose((ParmBlkPtr)&inparm, FALSE);
  1847.         PBClose((ParmBlkPtr)&outparm, FALSE);
  1848.     
  1849.         if (myerr != noErr)
  1850.             {
  1851.             p2cstr(to_name);
  1852.             p2cstr(from_name);
  1853.             Tcl_AppendResult(interp, "error copying RSRC \"",
  1854.                                 from_name, "\" to \"", to_name, "\" ", (char *) NULL);
  1855.             return TCL_ERROR;
  1856.             }
  1857.         if (eoferr != noErr)
  1858.             {
  1859.             Tcl_AppendResult(interp, "error setting RSRC EOF ",
  1860.                                 Tcl_MacGetError(interp, myerr), (char *) NULL);
  1861.             return TCL_ERROR;
  1862.             }
  1863.         }
  1864.     
  1865.     FlushVol(NULL, to_vrefnum);
  1866.  
  1867.     inparm.fileParam.ioCompletion = 0;
  1868.     inparm.fileParam.ioNamePtr = (unsigned char *)from_name;
  1869.     inparm.fileParam.ioVRefNum = from_vrefnum;
  1870.     inparm.fileParam.ioFVersNum = 0;
  1871.     inparm.fileParam.ioDirID = from_dirid;
  1872.     inparm.fileParam.ioFDirIndex = 0;
  1873.     myerr = PBHGetFInfo(&inparm, FALSE);
  1874.     if (myerr == noErr)
  1875.         {
  1876.         outparm.fileParam.ioCompletion = 0;
  1877.         outparm.fileParam.ioNamePtr = (unsigned char *)to_name;
  1878.         outparm.fileParam.ioVRefNum = to_vrefnum;
  1879.         outparm.fileParam.ioFVersNum = 0;
  1880.         outparm.fileParam.ioDirID = to_dirid;
  1881.         outparm.fileParam.ioFDirIndex = 0;
  1882.         outparm.fileParam.ioFlFndrInfo = inparm.fileParam.ioFlFndrInfo;
  1883.         outparm.fileParam.ioFlFndrInfo.fdLocation.h += 16;
  1884.         outparm.fileParam.ioFlFndrInfo.fdLocation.v += 16;
  1885.         GetDateTime(&outparm.fileParam.ioFlCrDat);
  1886.         outparm.fileParam.ioFlMdDat = outparm.fileParam.ioFlCrDat;
  1887.         myerr = PBHSetFInfo(&outparm, FALSE);
  1888.         if (myerr != noErr)
  1889.             {
  1890.             Tcl_AppendResult(interp, "error setting Finder info ",
  1891.                                 Tcl_MacGetError(interp, myerr), (char *) NULL);
  1892.             return TCL_ERROR;
  1893.             }
  1894.         }
  1895.     else
  1896.         {
  1897.         Tcl_AppendResult(interp, "error getting Finder info ",
  1898.                             Tcl_MacGetError(interp, myerr), (char *) NULL);
  1899.         return TCL_ERROR;
  1900.         }
  1901.     
  1902.     FlushVol(NULL, to_vrefnum);
  1903.     return TCL_OK;
  1904.     }
  1905.  
  1906. int
  1907. TclMac_CopyFork(inparm, outparm)
  1908.     HParamBlockRec    *inparm;
  1909.     HParamBlockRec    *outparm;
  1910.     {
  1911.     short            done, myerr;
  1912.     ParamBlockRec    ipb, opb;
  1913.     char            mybuffer[1024];
  1914.  
  1915.     for (done=false; ! done; )
  1916.         {
  1917.         ipb.ioParam.ioCompletion = 0;
  1918.         ipb.ioParam.ioRefNum = inparm->ioParam.ioRefNum;
  1919.         ipb.ioParam.ioReqCount = (long) sizeof(mybuffer);
  1920.         ipb.ioParam.ioBuffer = mybuffer;
  1921.         ipb.ioParam.ioPosMode = fsAtMark;
  1922.         ipb.ioParam.ioPosOffset = 0;
  1923.         
  1924.         myerr = PBRead( &ipb, (Boolean)0 );
  1925.         
  1926.         if (myerr == eofErr)
  1927.             done = true;
  1928.         else if (myerr != noErr)
  1929.             return myerr;
  1930.         
  1931.         if (ipb.ioParam.ioActCount > 0)
  1932.             {
  1933.             opb.ioParam.ioCompletion = 0;
  1934.             opb.ioParam.ioRefNum = outparm->ioParam.ioRefNum;
  1935.             opb.ioParam.ioReqCount = ipb.ioParam.ioActCount;
  1936.             opb.ioParam.ioBuffer = mybuffer;
  1937.             opb.ioParam.ioPosMode = fsAtMark;
  1938.             opb.ioParam.ioPosOffset = 0;
  1939.             
  1940.             myerr = PBWrite( &opb, (Boolean)0 );
  1941.             
  1942.             if (myerr != noErr)
  1943.                 return myerr;
  1944.             
  1945.             if ( ipb.ioParam.ioActCount != opb.ioParam.ioActCount )
  1946.                 done = true;
  1947.             }
  1948.         }
  1949.     
  1950.     return noErr;
  1951.     }
  1952.  
  1953. int
  1954. volname_to_vref(volname, vrefnum)
  1955.     char    *volname;
  1956.     short    *vrefnum;
  1957.     {
  1958.     int        myerr;
  1959.     char    pascal_name[32];
  1960.     HParamBlockRec    pb;
  1961.     
  1962.     strncpy(pascal_name, volname, 28);
  1963.     pascal_name[28] = '\0';
  1964.     c2pstr(pascal_name);
  1965.     
  1966.     if (pascal_name[ pascal_name[0] ] != ':')
  1967.         {
  1968.         pascal_name[ ++pascal_name[0] ] = ':';
  1969.         }
  1970.     
  1971.     pb.volumeParam.ioCompletion = 0;
  1972.     pb.volumeParam.ioVRefNum = 0;
  1973.     pb.volumeParam.ioNamePtr = (unsigned char *)pascal_name;
  1974.     pb.volumeParam.ioVolIndex = -1;
  1975.     
  1976.     myerr = PBHGetVInfo(&pb, FALSE);
  1977.     if (myerr == noErr)
  1978.         {
  1979.         *vrefnum = pb.volumeParam.ioVRefNum;
  1980.         }
  1981.     
  1982.     return myerr;
  1983.     }
  1984.  
  1985. tcl_path_to_dir(path, vRefNum, dirID)
  1986.     char    *path;
  1987.     short    *vRefNum;
  1988.     long    *dirID;
  1989.     {
  1990.     short    vref;
  1991.     int        myerr, result = noErr;
  1992.     long    dirid;
  1993.     char    *pathptr, *ptr, savech;
  1994.     CInfoPBRec        cpb;
  1995.     
  1996.     vref = TclMac_CWDVRefNum();
  1997.     dirid = TclMac_CWDDirID();
  1998.     
  1999.     ptr = strchr(path, ':');
  2000.     if (ptr == NULL)
  2001.         {
  2002.         /* No path, just a filename... */
  2003.         *vRefNum = vref;
  2004.         *dirID = dirid;
  2005.         return noErr;
  2006.         }
  2007.     
  2008.     if (*path == ':')
  2009.         {
  2010.         /* RELATIVE */
  2011.         pathptr = path + 1;
  2012.         if (*pathptr == '\0')
  2013.             {
  2014.             *vRefNum = vref;
  2015.             *dirID = dirid;
  2016.             return noErr;
  2017.             }
  2018.         }
  2019.     else
  2020.         {
  2021.         /* ABSOLUTE */
  2022.         ++ptr;
  2023.         savech = *ptr;
  2024.         *ptr = '\0';
  2025.         dirid = 2;    /* root level */
  2026.         
  2027.         myerr = volname_to_vref(path, &vref);
  2028.         if (myerr != noErr)
  2029.             return myerr;
  2030.         
  2031.         *ptr = savech;
  2032.         pathptr = ptr;
  2033.         }
  2034.  
  2035.     for ( ; ; )
  2036.         {
  2037.         if (*ptr == '\0')
  2038.             break;
  2039.         
  2040.         ptr = strchr(pathptr, ':');
  2041.         if (ptr == NULL)
  2042.             break;
  2043.         
  2044.         cpb.hFileInfo.ioCompletion = 0;
  2045.         cpb.hFileInfo.ioNamePtr = (unsigned char *)pathptr;
  2046.         cpb.hFileInfo.ioVRefNum = vref;
  2047.         cpb.hFileInfo.ioFDirIndex = 0;
  2048.         cpb.hFileInfo.ioDirID = dirid;
  2049.         
  2050.         savech = *ptr;
  2051.         *ptr = '\0';
  2052.         c2pstr(pathptr);
  2053.         
  2054.         myerr = PBGetCatInfo(&cpb, (Boolean)0);
  2055.  
  2056.         p2cstr(pathptr);
  2057.         *ptr = savech;
  2058.         pathptr = ++ptr;
  2059.  
  2060.         if (myerr != noErr)
  2061.             {
  2062.             result = myerr;
  2063.             break;
  2064.             }
  2065.         else
  2066.             {
  2067.             if ((cpb.hFileInfo.ioFlAttrib & ioDirMask) == 0)
  2068.                 {
  2069.                 /* UNDONE -- aliases? */
  2070.                 break;
  2071.                 }
  2072.             else
  2073.                 {
  2074.                 dirid = cpb.hFileInfo.ioDirID;
  2075.                 }
  2076.             }
  2077.         }
  2078.     
  2079.     *vRefNum = vref;
  2080.     *dirID = dirid;
  2081.     
  2082.     return result;
  2083.     }
  2084.  
  2085. /*
  2086.  *-----------------------------------------------------------------------------
  2087.  *
  2088.  * Mac_EvalResource --
  2089.  *    Used to extend the source command.  Sources Tcl code from a Text resource.
  2090.  *        Currently only sources the resouce by name file ID may be supported
  2091.  *        at a later date.
  2092.  *
  2093.  * Side Effects:
  2094.  *        Depends on the Tcl code in the resource.
  2095.  *
  2096.  * Results:
  2097.  *      Returns a Tcl result.
  2098.  *
  2099.  *-----------------------------------------------------------------------------
  2100.  */
  2101. int
  2102. Mac_EvalResource(interp, resourceName, resourceNumber, resourceFile)
  2103.     Tcl_Interp    *interp;        /* Interpreter in which to process file. */
  2104.     char        *resourceName;    /* Name of TEXT resource to source, NULL if number should be used. */
  2105.     int            resourceNumber;    /* Resource id of source. */
  2106.     char        *resourceFile;    /* Name of file to process.  NULL if application resource. */
  2107.     {
  2108.     Handle        sourceText;
  2109.     short        saveref, fileRef = -1;
  2110.     char         idStr[64], *ptr;
  2111.     char         pascal_name[256];
  2112.     int         result, size;
  2113.     struct stat    statbuf;
  2114.     
  2115.     saveref = CurResFile();
  2116.     
  2117.     if (resourceFile != NULL)
  2118.         {
  2119.         if ( stat(resourceFile, &statbuf ) < 0 )
  2120.             {
  2121.             Tcl_AppendResult(interp, "could not locate resource file \"",
  2122.                                 resourceFile, "\" ", Tcl_PosixError(interp), NULL);
  2123.             return TCL_ERROR;
  2124.             }
  2125.         
  2126.         ptr = strrchr( resourceFile, ':');
  2127.         if (ptr != NULL)
  2128.             strcpy(pascal_name, ptr+1);
  2129.         else
  2130.             strcpy(pascal_name, resourceFile);
  2131.         
  2132.         c2pstr(pascal_name);
  2133.         fileRef = HOpenResFile( statbuf.st_dev, statbuf.st_parid,
  2134.                                 (unsigned char *)pascal_name, fsRdPerm);
  2135.         if (fileRef == -1)
  2136.             {
  2137.             Tcl_AppendResult(interp, "could not open resource file \"",
  2138.                                 resourceFile, "\" ",
  2139.                                 Tcl_MacGetError(interp, ResError()), NULL);
  2140.             return TCL_ERROR;
  2141.             }
  2142.         
  2143.         UseResFile(fileRef);
  2144.         }
  2145.     else if (_tclmac_apprenum_ != -1)
  2146.         {
  2147.         UseResFile(_tclmac_apprenum_);
  2148.         }
  2149.     
  2150.     if (resourceName != NULL)
  2151.         {
  2152.         strcpy(pascal_name, resourceName);
  2153.         c2pstr(pascal_name);
  2154.         sourceText = GetNamedResource( (ResType)'TEXT', (unsigned char *)pascal_name );
  2155.         }
  2156.     else
  2157.         {
  2158.         sourceText = GetResource( (ResType)'TEXT', (short)resourceNumber );
  2159.         }
  2160.     
  2161.     if ( sourceText == NULL )
  2162.         {
  2163.         sprintf(idStr, "ID=%d", resourceNumber );
  2164.         Tcl_AppendResult(interp, "The resource \"",
  2165.                             (resourceName != NULL ? resourceName : idStr),
  2166.                             "\" could not be loaded from ",
  2167.                             (resourceFile != NULL ? resourceFile : "application"),
  2168.                             ".", NULL);
  2169.         return TCL_ERROR;
  2170.         }
  2171.     
  2172.     HLock(sourceText);
  2173.  
  2174.     size = SizeResource(sourceText);
  2175.     
  2176.     (*sourceText)[size - 1] = '\0';    /* Terminate it if resource didn't */
  2177.     
  2178.     result = Tcl_Eval( interp, *sourceText );
  2179.     if (result == TCL_RETURN)
  2180.         {
  2181.         result = TCL_OK;
  2182.         }
  2183.     else if (result == TCL_ERROR)
  2184.         {
  2185.         sprintf(idStr, "ID=%d", resourceNumber);
  2186.         Tcl_AppendResult(interp, " (rsrc \"",
  2187.                             (resourceName == NULL ? idStr : resourceName),
  2188.                             "\" ", NULL);
  2189.         sprintf(idStr, "%d", interp->errorLine);
  2190.         Tcl_AppendResult(interp, " line ", idStr, ") ", NULL);
  2191.         }
  2192.     
  2193.     HUnlock(sourceText);
  2194.     ReleaseResource( sourceText );
  2195.     
  2196.     if (fileRef != -1)
  2197.         CloseResFile(fileRef);
  2198.     
  2199.     UseResFile(saveref);
  2200.     
  2201.     return result;
  2202.     }
  2203.  
  2204. /*
  2205.  *----------------------------------------------------------------------
  2206.  *
  2207.  * Mac_SourceCmd --
  2208.  *
  2209.  *    This procedure is invoked to process the "source" Tcl command.
  2210.  *    See the user documentation for details on what it does.  In addition,
  2211.  *    it supports sourceing from the resource fork of type 'TEXT'.
  2212.  *
  2213.  * Results:
  2214.  *    A standard Tcl result.
  2215.  *
  2216.  * Side effects:
  2217.  *    See the user documentation.
  2218.  *
  2219.  *----------------------------------------------------------------------
  2220.  */
  2221.  
  2222. int
  2223. Mac_SourceCmd(clientData, interp, argc, argv)
  2224.     ClientData clientData;    /* Not used. */
  2225.     Tcl_Interp *interp;        /* Current interpreter. */
  2226.     int argc;                /* Number of arguments. */
  2227.     char **argv;            /* Argument strings. */
  2228.     {
  2229.     int        rsrcid = 0, i;
  2230.     char    *rsrcname = NULL;
  2231.     char    *rsrcfile = NULL;
  2232. #pragma unused (clientData)
  2233.     
  2234.     if (argc < 2)
  2235.         {
  2236.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  2237.                 " fileName | ?-rsrcfile path? [-rsrcname name | -rsrcid id]\"",
  2238.                 (char *) NULL);
  2239.         return TCL_ERROR;
  2240.         }
  2241.     else if (argc == 2)
  2242.         {
  2243.         return Tcl_EvalFile(interp, argv[1]);
  2244.         }
  2245.     else
  2246.         {
  2247.         for ( i = 1 ; i < argc ; ++i )
  2248.             {
  2249.             if (strcmp(argv[i], "-rsrcname") == 0)
  2250.                 {
  2251.                 rsrcname = argv[i + 1];
  2252.                 ++i;
  2253.                 }
  2254.             else if (strcmp(argv[i], "-rsrcid") == 0)
  2255.                 {
  2256.                 rsrcid = atoi(argv[i + 1]);
  2257.                 ++i;
  2258.                 }
  2259.             else if (strcmp(argv[i], "-rsrcfile") == 0)
  2260.                 {
  2261.                 rsrcfile = argv[i + 1];
  2262.                 ++i;
  2263.                 }
  2264.             else
  2265.                 {
  2266.                 Tcl_AppendResult(interp, "bad argument: should be \"", argv[0],
  2267.                     " fileName | [-rsrcname name | -rsrcid id] ?-rsrcfile path?\"",
  2268.                     (char *) NULL);
  2269.                 return TCL_ERROR;
  2270.                 }
  2271.             }
  2272.         
  2273.         return Mac_EvalResource( interp, rsrcname, rsrcid, rsrcfile);
  2274.         }
  2275.     
  2276.     }
  2277.  
  2278. int
  2279. Mac_BeepCmd(clientData, interp, argc, argv)
  2280.     ClientData clientData;
  2281.     Tcl_Interp *interp;
  2282.     int argc;
  2283.     char *argv[];
  2284.     {
  2285.     Handle        sound;
  2286.     Str255        sndName;    
  2287. #pragma unused (clientData)
  2288.  
  2289.     if ( argc == 1 )
  2290.         {
  2291.         SysBeep(1);
  2292.         return TCL_OK;
  2293.         }
  2294.     else if ( argc == 2 )
  2295.         {
  2296.         if ( ! strcmp(argv[1], "-list") )
  2297.             {
  2298.             int        count, i;
  2299.             short    id;
  2300.             Str255    theName;
  2301.             ResType    theType;
  2302.             
  2303.             Tcl_ResetResult( interp );
  2304.             count = CountResources( 'snd ' );
  2305.             for ( i = 1 ; i <= count ; i++ )
  2306.                 {
  2307.                 sound = GetIndResource( 'snd ', i );
  2308.                 if ( sound != NULL )
  2309.                     {
  2310.                     GetResInfo( sound, &id, &theType, theName );
  2311.                     if ( theName[0] == 0 ) continue;
  2312.                     theName[theName[0]+1] = '\0';
  2313.                     Tcl_AppendElement( interp, (char *) theName + 1 );
  2314.                     }
  2315.                 }
  2316.             
  2317.             return TCL_OK;
  2318.             }
  2319.         else
  2320.             {
  2321.             strcpy( (char *) sndName + 1, argv[1] );
  2322.             sndName[0] = strlen(argv[1]);
  2323.             sound = GetNamedResource( 'snd ', sndName );
  2324.             if ( sound != NULL )
  2325.                 {
  2326.                 SndPlay( NULL, sound, FALSE );
  2327.                 return TCL_OK;
  2328.                 }
  2329.             else {
  2330.                 Tcl_ResetResult( interp );
  2331.                 Tcl_AppendResult( interp, "Error: \"", argv[1], 
  2332.                     "\" is not a valid beep sound.  (Try beep -list)", NULL );
  2333.                 return TCL_ERROR;
  2334.                 }
  2335.             }
  2336.         }
  2337.     else
  2338.         {
  2339.         return TCL_ERROR;
  2340.         }
  2341.     }
  2342.  
  2343.  
  2344. #define CurrentSysEnvVersion    1
  2345.  
  2346. get_system_version(str)
  2347.     char    *str;
  2348.     {
  2349.     int            myerr = gestaltUnknownErr;
  2350.     long        gestaltLong;
  2351.     SysEnvRec    sysEnviron;
  2352.  
  2353.     if (GestaltAvailable())
  2354.         {        
  2355.         myerr = Gestalt(gestaltSystemVersion, &gestaltLong);
  2356.         if (myerr == noErr)
  2357.             {
  2358.             sprintf( str, "%d.%02d",
  2359.                         ( (gestaltLong >> 8) & 0x00FF ),
  2360.                         ( (gestaltLong) & 0x00FF ) );
  2361.             }
  2362.         }
  2363.     
  2364.     if (myerr != noErr)
  2365.         {
  2366.         memset(&sysEnviron, 0, sizeof(SysEnvRec));
  2367.         if (SysEnvirons(CurrentSysEnvVersion, &sysEnviron) != noErr)
  2368.             {
  2369.             strcpy( str, "0.0" );
  2370.             }
  2371.         else
  2372.             {
  2373.             sprintf( str, "%d.%02d",
  2374.                         ( (sysEnviron.systemVersion >> 8) & 0x00FF ),
  2375.                         ( (sysEnviron.systemVersion) & 0x00FF ) );
  2376.             }
  2377.         }
  2378.     }
  2379.  
  2380. get_machine_name(str)
  2381.     char    *str;
  2382.     {
  2383.     int            myerr = gestaltUnknownErr;
  2384.     short        index = 0;
  2385.     long        gestaltLong;
  2386.     SysEnvRec    sysEnviron;
  2387.  
  2388.     if (GestaltAvailable())
  2389.         {        
  2390.         myerr = Gestalt(gestaltSystemVersion, &gestaltLong);
  2391.         if (myerr == noErr)
  2392.             index = gestaltLong;
  2393.         }
  2394.     
  2395.     if (myerr != noErr)
  2396.         {
  2397.         memset(&sysEnviron, 0, sizeof(SysEnvRec));
  2398.         if (SysEnvirons(CurrentSysEnvVersion, &sysEnviron) == noErr)
  2399.             index = sysEnviron.machineType;
  2400.         }
  2401.     
  2402.     *str = '\0';
  2403.     if (index > 0)
  2404.         {
  2405.         GetIndString((unsigned char *)str, kMachineNameStrID, index);
  2406.         p2cstr(str);
  2407.         }
  2408.     
  2409.     if (*str == '\0')
  2410.         strcpy(str, "unknown");
  2411.     }
  2412.  
  2413. get_user_name(user_name)
  2414.     char    *user_name;
  2415.     {
  2416.     short        refnum;
  2417.     Handle        hdl;
  2418.     
  2419.     refnum = CurResFile();
  2420.     UseResFile(0);
  2421.     hdl = GetResource( (ResType)'STR ', -16096 );
  2422.     UseResFile(refnum);
  2423.     if (hdl)
  2424.         {
  2425.         LoadResource(hdl);
  2426.         HLock(hdl);
  2427.         sprintf( user_name, "%.*s",
  2428.                     ( **hdl > 31 ? 31 : **hdl ), (*hdl) + 1 );
  2429.         HUnlock(hdl);
  2430.         }
  2431.     else
  2432.         {
  2433.         strcpy(user_name, "anonymous");
  2434.         }
  2435.     }
  2436.  
  2437. char *
  2438. tcl_check_path_termination( char *path )
  2439.     {
  2440.     int        length;
  2441.     
  2442.     length = strlen(path);
  2443.     
  2444.     if ( path[ length-1 ] == ':' )
  2445.         path[ length-1 ] = '\0';
  2446.         
  2447.     return path;
  2448.     }
  2449.  
  2450. GetRefnumPathName(pathname, refnum)
  2451.     char    *pathname;
  2452.     int        refnum;
  2453.     {
  2454.     int            result;
  2455.     FCBPBRec    pb;
  2456.     Str32        name;
  2457.     
  2458.     pb.ioCompletion = 0;
  2459.     pb.ioVRefNum = 0;
  2460.     pb.ioRefNum = (short)refnum;
  2461.     pb.ioNamePtr = (unsigned char *)name;
  2462.     pb.ioFCBIndx = 0;
  2463.     
  2464.     result = PBGetFCBInfo( &pb, FALSE );
  2465.     if (result == noErr)
  2466.         {
  2467.         dirpathname(pathname, pb.ioVRefNum, pb.ioFCBParID);
  2468.         }
  2469.         
  2470.     return result;
  2471.     }
  2472.  
  2473. GetRefnumFileName(name, refnum)
  2474.     char    *name;
  2475.     int        refnum;
  2476.     {
  2477.     int            result;
  2478.     FCBPBRec    pb;
  2479.     
  2480.     pb.ioCompletion = 0;
  2481.     pb.ioVRefNum = 0;
  2482.     pb.ioRefNum = (short)refnum;
  2483.     pb.ioNamePtr = (unsigned char *)name;
  2484.     pb.ioFCBIndx = 0;
  2485.     
  2486.     result = PBGetFCBInfo( &pb, FALSE );
  2487.     
  2488.     return result;
  2489.     }
  2490.  
  2491. filter_C_string(into, from)
  2492.     char    *into;
  2493.     char    *from;
  2494.     {
  2495.     char    *ptr;
  2496.  
  2497.     ptr = into;
  2498.     for ( ; *from ; )
  2499.         {
  2500.         if (*from == '\\')
  2501.             {
  2502.             switch (*(from + 1))
  2503.                 {
  2504.                 case '\\':
  2505.                     *ptr++ = '\\';
  2506.                     from += 2;
  2507.                     break;
  2508.                 case 'r':
  2509.                     *ptr++ = '\015';
  2510.                     from += 2;
  2511.                     break;
  2512.                 case 'n':
  2513.                     *ptr++ = '\012';
  2514.                     from += 2;
  2515.                     break;
  2516.                 case 't':
  2517.                     *ptr++ = '\011';
  2518.                     from += 2;
  2519.                     break;
  2520.                 default:
  2521.                     if (isdigit(*(from+1)) &&
  2522.                         isdigit(*(from+2)) &&
  2523.                         isdigit(*(from+3)))
  2524.                         {
  2525.                         *ptr = ((*(from+1) - '0') * 64) +
  2526.                                 ((*(from+2) - '0') * 8) +
  2527.                                 (*(from+3) - '0');
  2528.                         ptr++; from += 4;
  2529.                         }
  2530.                     else
  2531.                         {
  2532.                         *ptr++ = *from++;
  2533.                         }
  2534.                     break;
  2535.                 }
  2536.             }
  2537.         else
  2538.             {
  2539.             *ptr++ = *from++;
  2540.             }
  2541.         }
  2542.     
  2543.     *ptr = '\0';
  2544.     
  2545.     return (int)(ptr - into);
  2546.     }
  2547.  
  2548. int
  2549. TclMac_ReadEnvInitFile( char * filename )
  2550.     {
  2551.     char    *ptr;
  2552.     FILE    *infile;
  2553.     char    input[512];
  2554.     char    filtered[512];
  2555.  
  2556.     infile = fopen(filename, "r");
  2557.     if (infile != NULL)
  2558.         {
  2559.         for ( ; fgets(input, sizeof(input)-1, infile) != NULL ; )
  2560.             {
  2561.             if (input[strlen(input)-1] == '\015')
  2562.                 input[strlen(input)-1] = '\0';
  2563.             if (input[strlen(input)-1] == '\012')
  2564.                 input[strlen(input)-1] = '\0';
  2565.             
  2566.             for (ptr=input; *ptr && *ptr != '='; ptr++)
  2567.                 ;
  2568.             
  2569.             if (*ptr == '=')
  2570.                 {
  2571.                 *ptr = '\0';
  2572.                 filter_C_string(filtered, ptr + 1);
  2573.                 TclSetEnv(input, filtered);
  2574.                 *ptr = '=';
  2575.                 }
  2576.             }
  2577.         
  2578.         fclose(infile);
  2579.         }
  2580.     
  2581.     return TCL_OK;
  2582.     }
  2583.  
  2584. int
  2585. TclMac_InitializeOnce(app_refnum)
  2586.     short    app_refnum;
  2587.     {
  2588.     _tclmac_apprenum_ = app_refnum;
  2589.     
  2590.     TclMac_InitializeEnvironment(app_refnum);
  2591.     
  2592.     TclMac_ReadEnvInitFile("•tclenv");
  2593.  
  2594.     return TCL_OK;
  2595.     }
  2596.  
  2597. int
  2598. TclMac_InitializeEnvironment(app_refnum)
  2599.     short    app_refnum;
  2600.     {
  2601.     short    vRefNum,
  2602.             myerr,
  2603.             has_find_folder;
  2604.     long    dirID,
  2605.             gestaltLong;
  2606.     char    pathbuf[1024],
  2607.             user_name[256],
  2608.             *ptr;
  2609.     Str32    app_fname;
  2610.     Tcl_DString    pathStr;
  2611.     
  2612.     get_user_name(user_name);
  2613.     TclSetEnv(kLoginnameTag, user_name);
  2614.     
  2615.     TclMac_CWDPathName(pathbuf);
  2616.     tcl_check_path_termination(pathbuf);
  2617.     TclSetEnv(kDefaultDirTag, pathbuf);
  2618.  
  2619.     GetRefnumFileName((char *)app_fname, app_refnum);
  2620.     p2cstr((char *)app_fname);
  2621.     TclSetEnv(kAppFileNameTag, (char *)app_fname);
  2622.     c2pstr((char *)app_fname);
  2623.  
  2624.     GetRefnumPathName(pathbuf, app_refnum);
  2625.     tcl_check_path_termination(pathbuf);
  2626.     TclSetEnv(kApplicationDirTag, pathbuf);
  2627.     
  2628.     Tcl_DStringInit(&pathStr);
  2629.     Tcl_DStringAppendElement(&pathStr, pathbuf);
  2630.     TclSetEnv(kDirPathTag, pathStr.string);
  2631.     Tcl_DStringFree(&pathStr);
  2632.     
  2633.     strcat(pathbuf, ":");
  2634.     strcat(pathbuf, user_name);
  2635.     TclSetEnv(kHomeDirTag, pathbuf);
  2636.     
  2637.     has_find_folder = 0;
  2638.     if (GestaltAvailable())
  2639.         {
  2640.         myerr = Gestalt(gestaltFindFolderAttr, &gestaltLong);
  2641.         if (myerr == noErr)
  2642.             if ((gestaltLong & (1 << gestaltFindFolderPresent)) != 0)
  2643.                 has_find_folder = 1;
  2644.         }
  2645.     
  2646.     if ( has_find_folder )
  2647.         {
  2648.         myerr = FindFolder( kOnSystemDisk, kSystemFolderType,
  2649.                             TRUE, &vRefNum, &dirID );
  2650.         dirpathname(pathbuf, vRefNum, dirID);
  2651.         tcl_check_path_termination(pathbuf);
  2652.         TclSetEnv(kSysFolderTag, pathbuf);
  2653.  
  2654.         myerr = FindFolder( kOnSystemDisk, kDesktopFolderType,
  2655.                             TRUE, &vRefNum, &dirID );
  2656.         dirpathname(pathbuf, vRefNum, dirID);
  2657.         tcl_check_path_termination(pathbuf);
  2658.         TclSetEnv(kDeskFolderTag, pathbuf);
  2659.  
  2660.         myerr = FindFolder( kOnSystemDisk, kTrashFolderType,
  2661.                             TRUE, &vRefNum, &dirID );
  2662.         dirpathname(pathbuf, vRefNum, dirID);
  2663.         tcl_check_path_termination(pathbuf);
  2664.         TclSetEnv(kTrashFolderTag, pathbuf);
  2665.         TclSetEnv(kShTrashFolderTag, pathbuf); /* ??? */
  2666.  
  2667.         myerr = FindFolder( kOnSystemDisk, kPrintMonitorDocsFolderType,
  2668.                             TRUE, &vRefNum, &dirID );
  2669.         dirpathname(pathbuf, vRefNum, dirID);
  2670.         tcl_check_path_termination(pathbuf);
  2671.         TclSetEnv(kPrintMonFolderTag, pathbuf);
  2672.  
  2673.         myerr = FindFolder( kOnSystemDisk, kStartupFolderType,
  2674.                             TRUE, &vRefNum, &dirID );
  2675.         dirpathname(pathbuf, vRefNum, dirID);
  2676.         tcl_check_path_termination(pathbuf);
  2677.         TclSetEnv(kStartUpFolderTag, pathbuf);
  2678.  
  2679.         myerr = FindFolder( kOnSystemDisk, kAppleMenuFolderType,
  2680.                             TRUE, &vRefNum, &dirID );
  2681.         dirpathname(pathbuf, vRefNum, dirID);
  2682.         tcl_check_path_termination(pathbuf);
  2683.         TclSetEnv(kAppleMenuFolderTag, pathbuf);
  2684.  
  2685.         myerr = FindFolder( kOnSystemDisk, kControlPanelFolderType,
  2686.                             TRUE, &vRefNum, &dirID );
  2687.         dirpathname(pathbuf, vRefNum, dirID);
  2688.         tcl_check_path_termination(pathbuf);
  2689.         TclSetEnv(kCPFolderTag, pathbuf);
  2690.  
  2691.         myerr = FindFolder( kOnSystemDisk, kExtensionFolderType,
  2692.                             TRUE, &vRefNum, &dirID );
  2693.         dirpathname(pathbuf, vRefNum, dirID);
  2694.         tcl_check_path_termination(pathbuf);
  2695.         TclSetEnv(kExtFolderTag, pathbuf);
  2696.  
  2697.         myerr = FindFolder( kOnSystemDisk, kPreferencesFolderType,
  2698.                             TRUE, &vRefNum, &dirID );
  2699.         dirpathname(pathbuf, vRefNum, dirID);
  2700.         tcl_check_path_termination(pathbuf);
  2701.         TclSetEnv(kPrefFolderTag, pathbuf);
  2702.  
  2703.         myerr = FindFolder( kOnSystemDisk, kTemporaryFolderType,
  2704.                             TRUE, &vRefNum, &dirID );
  2705.         dirpathname(pathbuf, vRefNum, dirID);
  2706.         tcl_check_path_termination(pathbuf);
  2707.         TclSetEnv(kTempFolderTag, pathbuf);
  2708.         }
  2709.     else
  2710.         {
  2711.         vRefNum = BlessedWD();
  2712.         pathname(pathbuf, vRefNum);
  2713.         tcl_check_path_termination(pathbuf);
  2714.         TclSetEnv(kSysFolderTag, pathbuf);
  2715.         
  2716.         ptr = pathbuf + strlen(pathbuf);
  2717.  
  2718.         strcpy(ptr, "Preferences:");
  2719.         TclSetEnv(kPrefFolderTag, pathbuf);
  2720.  
  2721.         strcpy(ptr, "Extensions:");
  2722.         TclSetEnv(kExtFolderTag, pathbuf);
  2723.  
  2724.         strcpy(ptr, "Control Panels:");
  2725.         TclSetEnv(kCPFolderTag, pathbuf);
  2726.  
  2727.         strcpy(ptr, "Apple Menu Items:");
  2728.         TclSetEnv(kAppleMenuFolderTag, pathbuf);
  2729.  
  2730.         strcpy(ptr, "PrintMonitor Documents:");
  2731.         TclSetEnv(kPrintMonFolderTag, pathbuf);
  2732.  
  2733.         strcpy(ptr, "Startup Items:");
  2734.         TclSetEnv(kStartUpFolderTag, pathbuf);
  2735.  
  2736.         ptr = strchr(pathbuf, ':');
  2737.         if (ptr != NULL)
  2738.             {
  2739.             strcpy( ptr + 1, "Trash:");
  2740.             TclSetEnv(kTrashFolderTag, pathbuf);
  2741.             TclSetEnv(kShTrashFolderTag, pathbuf); /* ??? */
  2742.  
  2743.             strcpy( ptr + 1, "Desktop Folder:");
  2744.             TclSetEnv(kDeskFolderTag, pathbuf);
  2745.  
  2746.             strcpy( ptr + 1, "Temporary Items:");
  2747.             TclSetEnv(kTempFolderTag, pathbuf);
  2748.             }
  2749.         }
  2750.     
  2751.     get_machine_name(pathbuf);
  2752.     TclSetEnv(kMachineNameTag, pathbuf);
  2753.  
  2754.     get_system_version(pathbuf);
  2755.     TclSetEnv(kSystemVersionTag, pathbuf);
  2756.     
  2757.     return TCL_OK;
  2758.     }
  2759.  
  2760. int
  2761. Tcl_AddMacintoshCmds(interp)
  2762. Tcl_Interp    *interp;
  2763.     {
  2764.     Tcl_CreateCommand(interp, "beep", Mac_BeepCmd,
  2765.                         (ClientData)NULL, (void (*)())NULL);
  2766.     Tcl_CreateCommand(interp, "cd", TclMac_CD,
  2767.                         (ClientData)NULL, (void (*)())NULL);
  2768.     Tcl_CreateCommand(interp, "cp", TclMac_CopyFile,
  2769.                         (ClientData)NULL, (void (*)())NULL);
  2770.     Tcl_CreateCommand(interp, "ctime", TclMac_CTime,
  2771.                         (ClientData)NULL, (void (*)())NULL);
  2772.     Tcl_CreateCommand(interp, "cvttime", TclMac_CvtTime,
  2773.                         (ClientData)NULL, (void (*)())NULL);
  2774.     Tcl_CreateCommand(interp, "echo", TclMac_Echo,
  2775.                         (ClientData)NULL, (void (*)())NULL);
  2776.     Tcl_CreateCommand(interp, "getfinfo", TclMac_GetFileInfo,
  2777.                         (ClientData)NULL, (void (*)())NULL);
  2778.     Tcl_CreateCommand(interp, "isalias", TclMac_IsAliasFile,
  2779.                         (ClientData)NULL, (void (*)())NULL);
  2780.     Tcl_CreateCommand(interp, "ls", TclMac_LS,
  2781.                         (ClientData)NULL, (void (*)())NULL);
  2782.     Tcl_CreateCommand(interp, "mkdir", TclMac_MkDir,
  2783.                         (ClientData)NULL, (void (*)())NULL);
  2784.     Tcl_CreateCommand(interp, "mtime", TclMac_DateTime,
  2785.                         (ClientData)NULL, (void (*)())NULL);
  2786.     Tcl_CreateCommand(interp, "mv", TclMac_MoveFile,
  2787.                         (ClientData)NULL, (void (*)())NULL);
  2788.     Tcl_CreateCommand(interp, "now", TclMac_Now,
  2789.                         (ClientData)NULL, (void (*)())NULL);
  2790.     Tcl_CreateCommand(interp, "pwd", TclMac_PWD,
  2791.                         (ClientData)NULL, (void (*)())NULL);
  2792.     Tcl_CreateCommand(interp, "resolve_alias", TclMac_ResolveAlias,
  2793.                         (ClientData)NULL, (void (*)())NULL);
  2794.     Tcl_CreateCommand(interp, "rm", TclMac_RM,
  2795.                         (ClientData)NULL, (void (*)())NULL);
  2796.     Tcl_CreateCommand(interp, "rmdir", TclMac_RmDir,
  2797.                         (ClientData)NULL, (void (*)())NULL);
  2798.     Tcl_CreateCommand(interp, "setfinfo", TclMac_SetFileInfo,
  2799.                         (ClientData)NULL, (void (*)())NULL);
  2800.     Tcl_CreateCommand(interp, "ticks", TclMac_Ticks,
  2801.                         (ClientData)NULL, (void (*)())NULL);
  2802.  
  2803.     Tcl_CreateCommand(interp, "source", Mac_SourceCmd,
  2804.                         (ClientData)NULL, (void (*)())NULL);
  2805.     
  2806.     return TCL_OK;
  2807.     }
  2808.  
  2809. int
  2810. Tcl_InitMacintosh(interp)
  2811. Tcl_Interp    *interp;
  2812.     {
  2813.     int        result;
  2814.     char    command[128];
  2815.  
  2816.     /* UNDONE - error handling */
  2817.     sprintf(command, "set MACINTOSH 1\n");
  2818.     result = Tcl_Eval(interp, command);
  2819.         
  2820.     sprintf(command, "set MAC_TCL 1\n");
  2821.     result = Tcl_Eval(interp, command);
  2822.     
  2823. #ifdef TCLENGINE
  2824.     sprintf(command, "set tcl_interactive 0\n");
  2825. #else
  2826.     sprintf(command, "set tcl_interactive 1\n");
  2827. #endif
  2828.     result = Tcl_Eval(interp, command);
  2829.     
  2830.     return TCL_OK;
  2831.     }
  2832.  
  2833. int
  2834. NumToolboxTraps()
  2835.     {
  2836.     if ( NGetTrapAddress(_InitGraf, ToolTrap)
  2837.             == NGetTrapAddress(0xAA6E, ToolTrap) )
  2838.         return 0x0200;
  2839.     else
  2840.         return 0x0400;
  2841.     }
  2842.  
  2843. TrapType
  2844. GetTrapType(short theTrap)
  2845.     {
  2846. #define TrapMask 0x0800
  2847.  
  2848.     if ((theTrap & TrapMask) != 0)
  2849.         return ToolTrap;
  2850.     else
  2851.         return OSTrap;
  2852.     }
  2853.  
  2854. TrapAvailable(short theTrap)
  2855.     {
  2856.     TrapType    tType;
  2857.  
  2858.     tType = GetTrapType(theTrap);
  2859.     if (tType == ToolTrap)
  2860.         {
  2861.         theTrap &=  0x07FF;
  2862.         if ( theTrap >= NumToolboxTraps() )
  2863.             theTrap = _Unimplemented;
  2864.         }
  2865.     
  2866.     return NGetTrapAddress(theTrap, tType) !=
  2867.             NGetTrapAddress(_Unimplemented, ToolTrap);
  2868.     }
  2869.  
  2870. WNEAvailable()
  2871.     {
  2872.     return TrapAvailable(_WaitNextEvent);
  2873.     }
  2874.  
  2875. GestaltAvailable()
  2876.     {
  2877.     return TrapAvailable(0xA1AD);
  2878.     }
  2879.  
  2880.  
  2881. int
  2882. TclMac_User_Wants_Break(interp)
  2883.     Tcl_Interp    *interp;
  2884.     {
  2885.     if (_tclmac_user_interrupt_)
  2886.         {
  2887.         Tcl_AppendResult(interp, " *** user interrupt *** ", (char *)0);
  2888.         _tclmac_user_interrupt_ = 0;
  2889.         return 1;
  2890.         }
  2891.  
  2892.     return 0;
  2893.     }
  2894.  
  2895. #ifdef EXAMPLE_SOURCE
  2896.  
  2897. check_environment_set_of_globals(name, value)
  2898.     char    *name;
  2899.     char    *value;
  2900.     {
  2901.  
  2902.     }
  2903.  
  2904. #endif
  2905.